From d4685683a265d53b28471e68c68ec8c6411e4aa7 Mon Sep 17 00:00:00 2001 From: Philip Kaludercic 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