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:
>>
>> ;; `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?

>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

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