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

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

[Philip Kaludercic]

[-- 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

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

[Lars Ingebrigtsen]

Philip Kaludercic <philipk@posteo.net> writes:

> 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.

The problem is that there's no limit to how people want to configure
their outgoing mail.

> +         (server (alist-get envelope-from smtpmail-smtp-server-alist
> +                            (list smtpmail-smtp-server)
> +                            nil #'string=))

And using just the envelope-from might be correct for your use case, but
it's not, in general, very useful.

If we want to add something like this to smtpmail, it has to allow a
full range of customisations for how to determine the server...  and
that's best done in the MUA, in my opinion.  Which is why it's
implemented via a header so the MUA can do this.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

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

[Philip Kaludercic]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Philip Kaludercic <philipk@posteo.net> writes:
>
>> 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.
>
> The problem is that there's no limit to how people want to configure
> their outgoing mail.

That might be the case, but this is certainly one popular use-case, at
least going by the activity seen on
https://www.emacswiki.org/emacs/MultipleSMTPAccounts.

>> +         (server (alist-get envelope-from smtpmail-smtp-server-alist
>> +                            (list smtpmail-smtp-server)
>> +                            nil #'string=))
>
> And using just the envelope-from might be correct for your use case, but
> it's not, in general, very useful.

Would it be better if a function were to be provided?  E.g. it would be
evaluated in the buffer and return the from address?

> If we want to add something like this to smtpmail, it has to allow a
> full range of customisations for how to determine the server...  and
> that's best done in the MUA, in my opinion.  Which is why it's
> implemented via a header so the MUA can do this.

The issue is that I am not writing using a MUA.  Sometimes I just open
C-x m directly or click on an email address, without Gnus being opened.
Sure, I can hook message-setup-hook to check from and insert
X-Message-SMTP-Method, but that's something everyone has to do for
themselves, over and over again.

-- 
	Philip Kaludercic

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

[Lars Ingebrigtsen]

Philip Kaludercic <philipk@posteo.net> writes:

> The issue is that I am not writing using a MUA.  Sometimes I just open
> C-x m directly or click on an email address, without Gnus being opened.
> Sure, I can hook message-setup-hook to check from and insert
> X-Message-SMTP-Method, but that's something everyone has to do for
> themselves, over and over again.

We could add a customisation to message-mode to insert the header based
on the criteria, like matching on the headers?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

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

[Philip Kaludercic]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Philip Kaludercic <philipk@posteo.net> writes:
>
>> The issue is that I am not writing using a MUA.  Sometimes I just open
>> C-x m directly or click on an email address, without Gnus being opened.
>> Sure, I can hook message-setup-hook to check from and insert
>> X-Message-SMTP-Method, but that's something everyone has to do for
>> themselves, over and over again.
>
> We could add a customisation to message-mode to insert the header based
> on the criteria, like matching on the headers?

While I do think it would be an improvement, I don't follow how it would
be preferable to implementing this in smtpmail?

-- 
	Philip Kaludercic

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

[Lars Ingebrigtsen]

Philip Kaludercic <philipk@posteo.net> writes:

> While I do think it would be an improvement, I don't follow how it would
> be preferable to implementing this in smtpmail?

Because that seems like the right layer -- that is, having multiple ways
to generate the header, instead of having some ways to generate the
header and then some other bits that don't, but work "further down", is
just confusing.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

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

[Philip Kaludercic]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Philip Kaludercic <philipk@posteo.net> writes:
>
>> While I do think it would be an improvement, I don't follow how it would
>> be preferable to implementing this in smtpmail?
>
> Because that seems like the right layer -- that is, having multiple ways
> to generate the header, instead of having some ways to generate the
> header and then some other bits that don't, but work "further down", is
> just confusing.

Excuse me for asking, but confusing to whom?  It would seem consistent
if an order of priority like

1. Header
2. server-alist/function
3. default server

would be guaranteed.

-- 
	Philip Kaludercic

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

[Lars Ingebrigtsen]

Philip Kaludercic <philipk@posteo.net> writes:

> Excuse me for asking, but confusing to whom?  It would seem consistent
> if an order of priority like
>
> 1. Header
> 2. server-alist/function
> 3. default server
>
> would be guaranteed.

The confusing bit comes when the user has configured several of these,
and expects one of them to have a priority that it doesn't have.  By
making this go through one single check point the priority becomes a
non-issue.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

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

[Philip Kaludercic]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Philip Kaludercic <philipk@posteo.net> writes:
>
>> Excuse me for asking, but confusing to whom?  It would seem consistent
>> if an order of priority like
>>
>> 1. Header
>> 2. server-alist/function
>> 3. default server
>>
>> would be guaranteed.
>
> The confusing bit comes when the user has configured several of these,
> and expects one of them to have a priority that it doesn't have.  By
> making this go through one single check point the priority becomes a
> non-issue.

I understand your point, but for this to work correctly I fear the
alternative could be more confusing.

Let's say I open a mail buffer with C-x m.  My default address is
inserted into the "From:" header. If I were to write my message, and
then decide to use my secondary address, I would either have to modify
the X-Message-SMTP-Method manually, or have it updated just before the
message is sent out.  The former is no improvement over the current
situation, and the second has the same potential for confusion, because
the user doesn't notice that the header is generated or updated.

-- 
	Philip Kaludercic

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

[Lars Ingebrigtsen]

Philip Kaludercic <philipk@posteo.net> writes:

> Let's say I open a mail buffer with C-x m.  My default address is
> inserted into the "From:" header. If I were to write my message, and
> then decide to use my secondary address, I would either have to modify
> the X-Message-SMTP-Method manually, or have it updated just before the
> message is sent out.  The former is no improvement over the current
> situation, and the second has the same potential for confusion, because
> the user doesn't notice that the header is generated or updated.

Or we could add a command like `message-update-smtp-method-header' and
people could call that (or add it to their hooks) after altering their
From (or whatever) headers.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

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

[Philip Kaludercic]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Philip Kaludercic <philipk@posteo.net> writes:
>
>> Let's say I open a mail buffer with C-x m.  My default address is
>> inserted into the "From:" header. If I were to write my message, and
>> then decide to use my secondary address, I would either have to modify
>> the X-Message-SMTP-Method manually, or have it updated just before the
>> message is sent out.  The former is no improvement over the current
>> situation, and the second has the same potential for confusion, because
>> the user doesn't notice that the header is generated or updated.
>
> Or we could add a command like `message-update-smtp-method-header' and
> people could call that (or add it to their hooks) after altering their
> From (or whatever) headers.

So if the mechanism is supposed to be kept general (instead of just
checking the From header), how would this differ from the already
existing message-send-mail-hook?

-- 
	Philip Kaludercic

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

[Lars Ingebrigtsen]

Philip Kaludercic <philipk@posteo.net> writes:

>> Or we could add a command like `message-update-smtp-method-header' and
>> people could call that (or add it to their hooks) after altering their
>> From (or whatever) headers.
>
> So if the mechanism is supposed to be kept general (instead of just
> checking the From header), how would this differ from the already
> existing message-send-mail-hook?

How a command would differ from a hook?  I'm not sure I understand the
question.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

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

[Philip Kaludercic]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Philip Kaludercic <philipk@posteo.net> writes:
>
>>> Or we could add a command like `message-update-smtp-method-header' and
>>> people could call that (or add it to their hooks) after altering their
>>> From (or whatever) headers.
>>
>> So if the mechanism is supposed to be kept general (instead of just
>> checking the From header), how would this differ from the already
>> existing message-send-mail-hook?
>
> How a command would differ from a hook?  I'm not sure I understand the
> question.

Oh, sorry I misunderstood your suggestion.  So you are thinking of
something that would be configured like:

--8<---------------cut here---------------start------------->8---
;; `message-server-alist' would match the From header[0] if it is a string,
;; or call a function in the current message buffer if it is a function.
(setq message-server-alist
      '(("foo@mail.com" . "smtp.mail.com")
        ("bar@post.de" . "post-spuep.de")))

(add-hook 'message-send-mail-hook #'message-update-smtp-method-header)
--8<---------------cut here---------------end--------------->8---

If so, then couldn't the add-hook just be dropped, and message always
checks message-server-alist before sending a message?

[0] Using From is probably not enough, e.g. when you try to resend a message.

-- 
	Philip Kaludercic

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

[Lars Ingebrigtsen]

Philip Kaludercic <philipk@posteo.net> writes:

>>>> Or we could add a command like `message-update-smtp-method-header' and
>>>> people could call that (or add it to their hooks) after altering their
>>>> From (or whatever) headers.
>>>
>>> So if the mechanism is supposed to be kept general (instead of just
>>> checking the From header), how would this differ from the already
>>> existing message-send-mail-hook?
>>
>> How a command would differ from a hook?  I'm not sure I understand the
>> question.
>
> Oh, sorry I misunderstood your suggestion.  So you are thinking of
> something that would be configured like:
>
> ;; `message-server-alist' would match the From header[0] if it is a string,
> ;; or call a function in the current message buffer if it is a function.
> (setq message-server-alist
>       '(("foo@mail.com" . "smtp.mail.com")
>         ("bar@post.de" . "post-spuep.de")))
>
> (add-hook 'message-send-mail-hook #'message-update-smtp-method-header)

No, I meant:

>>>> Or we could add a command like `message-update-smtp-method-header' and
>>>> people could call that

> If so, then couldn't the add-hook just be dropped, and message always
> checks message-server-alist before sending a message?

Yes.

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

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

[Philip Kaludercic]

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

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Philip Kaludercic <philipk@posteo.net> writes:
>
>>>>> Or we could add a command like `message-update-smtp-method-header' and
>>>>> people could call that (or add it to their hooks) after altering their
>>>>> From (or whatever) headers.
>>>>
>>>> So if the mechanism is supposed to be kept general (instead of just
>>>> checking the From header), how would this differ from the already
>>>> existing message-send-mail-hook?
>>>
>>> How a command would differ from a hook?  I'm not sure I understand the
>>> question.
>>
>> Oh, sorry I misunderstood your suggestion.  So you are thinking of
>> something that would be configured like:
>>
>> ;; `message-server-alist' would match the From header[0] if it is a string,
>> ;; or call a function in the current message buffer if it is a function.
>> (setq message-server-alist
>>       '(("foo@mail.com" . "smtp.mail.com")
>>         ("bar@post.de" . "post-spuep.de")))
>>
>> (add-hook 'message-send-mail-hook #'message-update-smtp-method-header)
>
> No, I meant:
>
>>>>> Or we could add a command like `message-update-smtp-method-header' and
>>>>> people could call that
>
>> If so, then couldn't the add-hook just be dropped, and message always
>> checks message-server-alist before sending a message?
>
> Yes.

Ok, so how does this look like?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Automatically-insert-X-Message-SMTP-Method-headers.patch --]
[-- Type: text/x-diff, Size: 3119 bytes --]

From c1dec09a725b440380a01c71435b24fc4cd905c0 Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <philipk@posteo.net>
Date: Sun, 19 Dec 2021 22:53:59 +0100
Subject: [PATCH] Automatically insert X-Message-SMTP-Method headers

* message.el (message-server-alist): Add user option
(message-update-smtp-method-header): Add function
(message-send): Call message-update-smtp-method-header
---
 lisp/gnus/message.el | 40 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)

diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 285369b84c..24a12af3c9 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -1,4 +1,4 @@
-;;; message.el --- composing mail and news messages -*- lexical-binding: t -*-
+;;; message.el --- composing mail and news messages -*- lexical- t -*-
 
 ;; Copyright (C) 1996-2021 Free Software Foundation, Inc.
 
@@ -4335,6 +4335,43 @@ message-bury
 
 (autoload 'mml-secure-bcc-is-safe "mml-sec")
 
+(defcustom message-server-alist nil
+  "Alist of rules to generate \"X-Message-SMTP-Method\" headers.
+If any entry of the form (COND . METHOD) matches, the header will
+be inserted just before the message is sent.  If COND is a
+string, METHOD will be inserted if the \"From\" header matches
+COND.  If COND is a function, METHOD will be inserted if COND
+returns a non-nil value, when called in the message buffer
+without any arguments.  If METHOD is nil in the last case, the
+return value of the function will be returned instead.  None of
+this applies if the buffer already has a\"X-Message-SMTP-Method\"
+header."
+  :type '(alist :key-type '(choice
+                            (string :tag "From Address")
+                            (function :tag "Predicate"))
+                :value-type 'string)
+  :version "29.1"
+  :group 'message-sending)
+
+(defun message-update-smtp-method-header ()
+  "Check `message-server-alist' to insert a SMTP-Method header."
+  (unless (message-fetch-field "X-Message-SMTP-Method")
+    (let ((from (mail-extract-address-components (message-fetch-field "From")))
+          method)
+      (catch 'exit
+        (dolist (server message-server-alist)
+          (cond ((functionp (car server))
+                 (let ((res (funcall (car server))))
+                   (when res
+                     (setq method (or (cdr server) res))
+                     (throw 'exit nil))))
+                ((and (stringp (car server))
+                      (string= (car server) from))
+                 (setq method (cdr server))
+                 (throw 'exit nil)))))
+      (when method
+        (message-add-header (concat "X-Message-SMTP-Method: " method))))))
+
 (defun message-send (&optional arg)
   "Send the message in the current buffer.
 If `message-interactive' is non-nil, wait for success indication or
@@ -4348,6 +4385,7 @@ message-send
   (undo-boundary)
   (let ((inhibit-read-only t))
     (put-text-property (point-min) (point-max) 'read-only nil))
+  (message-update-smtp-method-header)
   (message-fix-before-sending)
   (run-hooks 'message-send-hook)
   (mml-secure-bcc-is-safe)
-- 
2.30.2


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


This calls message-update-smtp-method-header before message-send-hook,
but I could also see adding message-update-smtp-method-header to the
hook in message.el, so that a user may remove it if needed.

-- 
	Philip Kaludercic

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

[Lars Ingebrigtsen]

Philip Kaludercic <philipk@posteo.net> writes:

> Ok, so how does this look like?

Looks good to me, except this typo:

> -;;; message.el --- composing mail and news messages -*- lexical-binding: t -*-
> +;;; message.el --- composing mail and news messages -*- lexical- t -*-

So go ahead and push (but with a NEWS entry and some message.texi
documentation).

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

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

[Lars Ingebrigtsen]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> So go ahead and push (but with a NEWS entry and some message.texi
> documentation).

This was done at the time, but the bug report was left open, so I'm
closing it now.