bug#52205: Allow configuring multiple mail accounts for smtpmail.el

[Philip Kaludercic <philipk@posteo.net>]

[-- Attachment #1: Type: text/plain, Size: 1137 bytes --]

Tags: patch

Tags: patch


Hi,

the below patch should allow for multiple mail accounts being configured
for smtpmail.el, without having to use tricks like
X-Message-SMTP-Method, that only work when the MUA also inserts them at
the right time.

This is an initial patch, and everything seems to work on my end.  I had
a little issue with the indentation, because Emacs re-indented
everything at first, but I didn't want to send a patch consisting of
mainly unrelated whitespace changes.

In GNU Emacs 28.0.60 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.24.24, cairo version 1.16.0)
 of 2021-11-30 built on viero
Repository revision: c4daff9cf844ec85930bdcd2064787c92c260861
Repository branch: emacs-28
Windowing system distributor 'The X.Org Foundation', version 11.0.12011000
Configured using:
 'configure CC=gcc
 PKG_CONFIG_PATH=/gnu/store/sfqc239vzd9d1hxmnvav385x1nl9zx5d-profile/lib/pkgconfig:/gnu/store/sfqc239vzd9d1hxmnvav385x1nl9zx5d-profile/share/pkgconfig:/home/philip/.guix-profile/lib/pkgconfig:/home/philip/.guix-profile/share/pkgconfig:/home/philip/.guix-profile/lib/pkgconfig:/home/philip/.guix-profile/share/pkgconfig'


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Allow-configuring-multiple-mail-accounts-for-smtpmai.patch --]
[-- Type: text/patch, Size: 3144 bytes --]

From d4685683a265d53b28471e68c68ec8c6411e4aa7 Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <philipk@posteo.net>
Date: Tue, 30 Nov 2021 20:00:58 +0100
Subject: [PATCH] Allow configuring multiple mail accounts for smtpmail.el

* lisp/mail/smtpmail.el (smtpmail-smtp-server-alist): New option to
  configure what server to use for what outgoing address.
---
 lisp/mail/smtpmail.el | 31 ++++++++++++++++++++++++-------
 1 file changed, 24 insertions(+), 7 deletions(-)

diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index bd8aa611e9..95e7abdeae 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -78,6 +78,19 @@ smtpmail-smtp-server
   "The name of the host running SMTP server."
   :type '(choice (const nil) string))
 
+(defcustom smtpmail-smtp-server-alist '()
+  "Alist of SMTP servers for different addresses."
+  :type '(alist :key-type
+                (string :tag "Sender")
+                :value-type
+                (list (string :tag "SMTP Server")
+                      (natnum :tag "Service")
+                      (choice :tag "Stream type"
+                              (const :tag "Possibly upgrade to STARTTLS" nil)
+                              (const :tag "Always use STARTTLS" starttls)
+                              (const :tag "Never use STARTTLS" plain)
+                              (const :tag "Use TLS/SSL" ssl)))))
+
 (defcustom smtpmail-smtp-service 25
   "SMTP service port number.
 The default value would be \"smtp\" or 25."
@@ -706,13 +719,9 @@ smtpmail-user-mail-address
 (defun smtpmail-via-smtp (recipient smtpmail-text-buffer
 				    &optional ask-for-password
                                     send-attempts)
-  (unless smtpmail-smtp-server
+  (unless (or smtpmail-smtp-server smtpmail-smtp-server-alist)
     (smtpmail-query-smtp-server))
-  (let ((process nil)
-        (send-attempts (or send-attempts 1))
-	(host (or smtpmail-smtp-server
-		  (error "`smtpmail-smtp-server' not defined")))
-	(port smtpmail-smtp-service)
+  (let* ((process nil)
         ;; `smtpmail-mail-address' should be set to the appropriate
         ;; buffer-local value by the caller, but in case not:
         (envelope-from
@@ -727,6 +736,14 @@ smtpmail-via-smtp
 	         (and from
 		      (cadr (mail-extract-address-components from))))
 	       (smtpmail-user-mail-address))))
+         (send-attempts (or send-attempts 1))
+         (server (alist-get envelope-from smtpmail-smtp-server-alist
+                            (list smtpmail-smtp-server)
+                            nil #'string=))
+         (host (or (car server)
+                   (error "No known SMTP Server for %S" envelope-from)))
+         (port (or (cadr server)
+                   smtpmail-smtp-service))
 	process-buffer
 	result
 	auth-mechanisms
@@ -757,7 +774,7 @@ smtpmail-via-smtp
 	    (setq result
 		  (open-network-stream
 		   "smtpmail" process-buffer host port
-		   :type smtpmail-stream-type
+		   :type (or (caddr server) smtpmail-stream-type)
 		   :return-list t
 		   :warn-unless-encrypted ask-for-password
 		   :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn))
-- 
2.34.0


[-- Attachment #3: Type: text/plain, Size: 24 bytes --]


-- 
	Philip Kaludercic