use several identities when sending mail

classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view

use several identities when sending mail

Francesco Potortì-2
About ten years ago I wrote some code for switching identitites when
sending mail with sendmail-user-agent.

I just revamped it to use the smtp library and, unless something like
that already exists, I think this is a worthwhile addition to Emacs,
once it is cleaned up.  I think it should work with message mode too.

I attach the code below as it is.  It works, but it needs cleanup, or
submission to Elpa, or to the wiki.  If people are interested in the
code and in publishing it, that may avoid ten more years waiting.

===File ~/elisp/mail-identity.el============================
:;; Define identities for sending mail
:;; For Emacs 24 and newer
:;; GPL v3 or later
:;; Francesco Potortì, 2000-2021
;;; Supports sendmail and smtpmail transports, no support for feedmail or mailclient

(setq smtpmail-debug-info nil)

;; List of identities
(defvar mail-identity-list
     "[hidden email]"
     ("" "pot" 587)
     "CNR-ISTI, via Moruzzi 1, I-56124 Pisa, +39-0503153058"
     "X-fingerprint: 4B02 6187 5C03 D6B1 2E31  7666 09DF 2DC9 BE21 6115")
     "[hidden email]"
     ("" "francesco.potorti" 25)
     "CNR-ISTI, via Moruzzi 1, I-56124 Pisa, +39-0503153058"
     "X-fingerprint: 4B02 6187 5C03 D6B1 2E31  7666 09DF 2DC9 BE21 6115")
     "[hidden email]"
     ("" "pot" 25)
     "The GNU project"
     "X-fingerprint: 4B02 6187 5C03 D6B1 2E31  7666 09DF 2DC9 BE21 6115")
     "[hidden email]"
     ("" "pot" 465 ssl)
     "IPIN 2019 conference"
     "From: Francesco Potortì -- general chair <[hidden email]>"
     "CC: IPIN 2019 conference <[hidden email]>")
  "List of possible mail sending styles.
The car of each element of the list is a unique string that is the style name.
The following elements are:
- value for `user-mail-address' which is the only necessary element after the name
- a list with the following elements (trailing missing ones are set to nil)
  - value for `smtpmail-smtp-server'
  - value for `smtpmail-smtp-user'
  - value for `smtpmail-smtp-service'
  - value for `smtpmail-stream-type'
- value for `message-user-organization', if any
- any number of header lines, each without a trailing newline")

;; The default identity
(defvar mail-default-identity
  (car (car mail-identity-list))
  "Default style for sending mail")

;; Assume all servers require authorization
(setq smtpmail-servers-requiring-authorization ".")

;; Use this in mail sending hooks for setting your identity (see below)
(defun mail-choose-identity ()
  (let* ((completion-ignore-case t)
          (completing-read "Mail sending style: "
                           (append '("sendmail" "local") mail-identity-list)
                           nil 'required nil nil
                           mail-default-identity t))
         (identity (cdr (assoc style mail-identity-list))))

    (if (string-match-p "^\\(smtpmail\\|local\\)$" style)
        (setq send-mail-function 'sendmail-send-it ; use local transport
              (read-string "From: " nil nil
                           (cadr (assoc mail-default-identity
      (setq send-mail-function 'smtpmail-send-it ; use smtp transport
            user-mail-address (nth 0 identity)
            smtpmail-smtp-server  (nth 0 (nth 1 identity))
            smtpmail-smtp-user    (nth 1 (nth 1 identity))
            smtpmail-smtp-service (nth 2 (nth 1 identity))
            smtpmail-stream-type  (nth 3 (nth 1 identity))
            message-user-organization (nth 2 identity)))

    ;; Insert headers specific to identity, if any
    (when message-user-organization
      (goto-char (mail-header-end))
      (unless (search-backward "\nOrganization: " nil t)
        (insert "Organization: " message-user-organization "\n")))
    (dolist (hdr (nthcdr 3 identity))
      (goto-char (mail-header-end))
      (unless (search-backward (concat "\n" hdr "\n") nil t)
        (insert hdr "\n")))

(add-hook 'mail-send-hook 'mail-choose-identity)
(add-hook 'message-send-hook 'mail-choose-identity)
(defadvice rmail-resend (before mail-choose-identity activate)
  (if (interactive-p) (funcall 'mail-choose-identity)))