MultipleSMTPAccounts

Basically, there are three possible approaches to let gnus decide which SMTP server should be used for sending email.

Unfortunately, there doesn’t exist a built-in feature set to decide which SMTP server should be used by looking at the “From:” header line of the current post. However, this can be easily implemented by using message hooks. Here are a couple of functions that will do this for you.

 ;; Let Gnus change the "From:" line by looking at current group we are in.
 (setq gnus-posting-styles
       '(("foo" (address "me@foo.com"))
         ("bar" (address "me@bar.com"))
         ("baz" (address "me@baz.com"))))
 ;; Available SMTP accounts.
 (defvar smtp-accounts
   '((plain    "me@foo.com" "smtp.foo.com" 25  "user-foo" "pass-foo")
     (login    "me@foo.com" "smtp.moo.com" 25  "user-moo" nil)
     (cram-md5 "me@foo.com" "smtp.hoo.com" 25  "user-hoo" nil)
     (ssl      "me@bar.com" "smtp.bar.com" 587 "user-bar" "pass-bar" "key" "cert")
     (ssl      "me@baz.com" "smtp.baz.com" 587 "user-baz" "pass-baz" "key" "cert")))

Each component of smtp-accounts has the form

 (protocol  "adres_matched_in_From_field@foo.com"  "protocol.foo.com"  "port"  "user@foo.com" "password" "key" "cert")

where KEY and CERT are optional. Setting PASSWORD to NIL will make SMTPMAIL-SEND-IT prompt for a password before sending every message. (More secure, more bugging.)

 ;; Default smtpmail.el configurations.
 (require 'cl)
 (require 'smtpmail)
 (setq send-mail-function 'smtpmail-send-it
       message-send-mail-function 'smtpmail-send-it
       mail-from-style nil
       user-full-name "Johnny B. Good"
       smtpmail-debug-info t
       smtpmail-debug-verb t)
 (defun set-smtp (mech server port user password)
   "Set related SMTP variables for supplied parameters."
   (setq smtpmail-smtp-server server
         smtpmail-smtp-service port
         smtpmail-auth-credentials (list (list server port user password))
         smtpmail-auth-supported (list mech)
         smtpmail-starttls-credentials nil)
   (message "Setting SMTP server to `%s:%s' for user `%s'."
            server port user))
 (defun set-smtp-ssl (server port user password  &optional key cert)
   "Set related SMTP and SSL variables for supplied parameters."
   (setq starttls-use-gnutls t
         starttls-gnutls-program "gnutls-cli"
         starttls-extra-arguments nil
         smtpmail-smtp-server server
         smtpmail-smtp-service port
         smtpmail-auth-credentials (list (list server port user password))
         smtpmail-starttls-credentials (list (list server port key cert)))
   (message
    "Setting SMTP server to `%s:%s' for user `%s'. (SSL enabled.)"
    server port user))
 (defun change-smtp ()
   "Change the SMTP server according to the current from line."
   (save-excursion
     (loop with from = (save-restriction
                         (message-narrow-to-headers)
                         (message-fetch-field "from"))
           for (auth-mech address . auth-spec) in smtp-accounts
           when (string-match address from)
           do (cond
               ((memq auth-mech '(cram-md5 plain login))
                (return (apply 'set-smtp (cons auth-mech auth-spec))))
               ((eql auth-mech 'ssl)
                (return (apply 'set-smtp-ssl auth-spec)))
               (t (error "Unrecognized SMTP auth. mechanism: `%s'." auth-mech)))
           finally (error "Cannot infer SMTP information."))))

In order to trigger CHANGE-SMTP before every SMTPMAIL-VIA-SMTP call, we introduce an advice as follows.

  (defadvice smtpmail-via-smtp
    (before smtpmail-via-smtp-ad-change-smtp (recipient smtpmail-text-buffer))
    "Call `change-smtp' before every `smtpmail-via-smtp'."
    (with-current-buffer smtpmail-text-buffer (change-smtp)))
  
  (ad-activate 'smtpmail-via-smtp)

— Volkan YAZICI

You may have to consider two more variables if your MTA checks your mail address specified in “MAIL FROM:” SMTP header line to decide whether you are allowed to send mail (Exchange does this). By default ‘smtpmail-mail-address’ is used if it is specified, otherwise ‘user-mail-address’. However, you probably don’t set ‘smtpmail-mail-address’ and your ‘user-mail-address’ contains your default e-mail address that is different from the one you use for a particular SMTP server. If you want to direct smtpmail.el to use the From field of the mail, set ‘mail-specify-envelope-from’ to t and ‘mail-envelope-from’ to header.

I think the above snippet will not work on a recent Emacs 24 from the bzr trunk since smtpmail.el has been rewritten. I think this is the relevant change: http://lists.gnu.org/archive/html/emacs-diffs/2011-06/msg00226.html

I upgraded to emacs bzr rev. 105301 yesterday. It still works with Volkan’s smtp function. Lars did a good job it seems.

I am getting “smtp-server not defined” with a recent emacs-snapshot. Any ideas?

For reference, the “smtp-server not defined” error is due to FLIM’s conflicting smtp implementation. An “aptitude purge flim” solved the problem.


This version is a bit simpler than the above because it only has two SMTP accounts and no SSL. --tzz

 (defun tzz-change-smtp ()
   "Change the SMTP server according to the current from line."
   (save-excursion
     (save-restriction
       (message-narrow-to-headers)
       (let* ((from (message-fetch-field "from"))
	      (from-work (string-match "workaddress" from))) ;; is this a "work" From address?
	 (setq smtpmail-smtp-service (if from-work 235 25)   ;; the SMTP port at work is different
	       smtpmail-smtp-server (if from-work
	 			       "worksmtp"           ;; the SMTP server at work
	 			     "regularsmtp")         ;; the SMTP server otherwise
	       smtpmail-default-smtp-server smtpmail-smtp-server)))))
 (add-hook 'message-send-hook 'tzz-change-smtp)

Are there plans to integrate this (the first solution) in the official distribution?

This doesn’t seem to work. apply: Wrong number of arguments: #[(server port key cert) “Æ^PÇ^QÈ^R^K^T^M^V^K^K^M^N^L^N^MFC^V^N^K^M^N^O^N^PFC^V^QÉÊ^K^M^N^R$?” [starttls-use-gnutls starttls-gnutls-program starttls-extra-arguments server smtpmail-smtp-server port t “gnutls-cli” nil message …] 5 (”/home/goo/.gnus.el” . 1634)], 6

How about using ‘gnus-posting-styles’ for setting the SMTP server? All that’s required is a special header field “X-SMTP-Server:”, which names the SMTP server to use for sending. ‘smtpmail-via-smtp’ will be avised to use a local version of ‘smtpmail-smtp-server’.

  (eval-after-load "smtpmail"
    '(progn
      (defun smtpmail-get-and-delete-smtp-server-from-header ()
        "Find header field X-SMTP-Server and if found return value as
         string and delete header field. If a header field of this
         name doesn't exist, return nil."
        (save-excursion
        (goto-char (point-min))
        (save-match-data
          (let ((smtp-server))
            (loop until (or (eobp) (looking-at "^[ \t]*$"))
              if (looking-at "X-SMTP-Server[ \t]*:[ \t]*\\(.*?\\)[ \t]*\n")
              return (prog1 (match-string 1) (replace-match ""))
              else
              do (forward-line 1))))))
  
      (defadvice smtpmail-via-smtp (around set-smtp-server-from-header activate)
        (let ((smtpmail-smtp-server (or (smtpmail-get-and-delete-smtp-server-from-header)
                                      smtpmail-smtp-server)))
        ad-do-it
        ))))
  (setq gnus-posting-styles
        '(;
          (".*"
           )
          ("^nnimap\\+imap\\.foo\\.bar:"
           ("X-SMTP-Server" "smtp.foo.bar")
           )
          ))

If a non-standard port is required, the above could easily be extended using a servername:port pattern.

— Marcus Harnisch

That is very elegant and intriguing! I tried it but it didn’t work quite as well as Volkan’s function, unfortunately. For some reason it did not read .authinfo.gpg. Furthermore it only worked with one of my smtp out-of-the-box. I didn’t have time to investigate, but the problem must be in the advice. However, I totally believe that Marcus’ idea is the way to go. It is much more intuitive and easier to extent.

I am sorry that my solution doesn’t seem to work for you. Please let me know your findings if you can make some time debugging things. Meanwhile I was able to streamline the code since a lot of the functionality is provided by Gnus’ companion libraries:

  (eval-after-load "smtpmail"
    '(progn
      (defadvice smtpmail-via-smtp (around set-smtp-server-from-header activate)
        (let ((smtpmail-smtp-server (or 
                                     (save-restriction
                                       (message-narrow-to-headers)
                                       (mail-fetch-field "X-SMTP-Server"))
                                     smtpmail-smtp-server)))
          (message-remove-header "X-SMTP-Server")
          ad-do-it
          ))))

See above for the additional ‘gnus-posting-styles’ modification.

In the recently released Emacs 24.1, one could utilitize the fact that SMTPMAIL would consult ~/.authinfo for all credential details, and the brand new smtpmail-stream-type variable makes using a separate (set-smtp-ssl) unnecessary. In fact the original solution could be widely simplified to using only one function for the defadvise:

    (require 'cl)
    (setq smtpmail-stream-type 'ssl) ;; If using TLS/SSL.  Use C-h v smtpmail-stream-type RET to see possible values
    (setq smtp-accounts
          '(("aa@bb.cc" "John Doe" "default.server.com")
            ("qq@rr.ss" "Mary Johnson" "server2.com")))
  
    (defun my-change-smtp ()
      (save-excursion
        (loop with from = (save-restriction
                            (message-narrow-to-headers)
                            (message-fetch-field "from"))
              for (addr fname server) in smtp-accounts
              when (string-match addr from)
              do (setq user-mail-address addr
                       user-full-name fname
                       smtpmail-smtp-user addr
                       smtpmail-smtp-server server))))
  
    (defadvice smtpmail-via-smtp
      (before change-smtp-by-message-from-field (recipient buffer &optional ask) activate)
      (with-current-buffer buffer (my-change-smtp)))
  
    (setq user-mail-address "aa@bb.cc"
          user-full-name "John Doe"
          smtpmail-smtp-server "default.server.com"
          smtpmail-auth-credentials (expand-file-name "~/.authinfo"))

Following code makes use of gnus-newsgroup-name variable. It adds a hook for message-mode. This makes sense as FROM field is also handled in these function.You can extend to more number of smtp servers.

    ;;To set the yahoo smtp details
    (defun setYahoo ()
      (interactive)
      (message "from yahoo")
      (setq user-mail-address "Ymailusername@yahoo.co.in")
      (setq message-send-mail-function 'smtpmail-send-it
            smtpmail-auth-credentials '(("smtp.mail.yahoo.com" 587 "Ymail@yahoo.co.in" nil))
            smtpmail-default-smtp-server "smtp.mail.yahoo.com"
            smtpmail-smtp-server "smtp.mail.yahoo.com"
            smtpmail-smtp-service 587
            smtpmail-local-domain "yahoo.com"))
    ;;To set gmail smtp details
    (defun setGmail ()
      (interactive)
      (message "from gmail")
      (setq user-mail-address "GmailUsername@gmail.com")
      (setq message-send-mail-function 'smtpmail-send-it
            smtpmail-starttls-credentials '(("smtp.gmail.com" 587 nil nil))
            smtpmail-auth-credentials '(("smtp.gmail.com" 587 "GmailUsername@gmail.com" nil))
            smtpmail-default-smtp-server "smtp.gmail.com"
            smtpmail-smtp-server "smtp.gmail.com"
            smtpmail-smtp-service 587
            smtpmail-local-domain "gmail.com"))
    ;;Select automatically while replying 
    ;;(add-hook 'message-mode-hook 'showMsg)
    (add-hook 'message-mode-hook
              '(lambda ()
                 (cond ((string-match "yahoomail" gnus-newsgroup-name) (setYahoo))
                       (t (setGmail)))))

- Abhijeet Dhadge


CategoryGnus