diff options
Diffstat (limited to 'lisp/mail')
| -rw-r--r-- | lisp/mail/rmail.el | 83 | ||||
| -rw-r--r-- | lisp/mail/rmailmm.el | 4 | ||||
| -rw-r--r-- | lisp/mail/sendmail.el | 88 | ||||
| -rw-r--r-- | lisp/mail/smtpmail.el | 66 |
4 files changed, 166 insertions, 75 deletions
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index c43ec9e561..ac07f07a76 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4249,7 +4249,7 @@ TEXT and INDENT are not used." ;; rmail-output expands non-absolute filenames against rmail-default-file. ;; What is the point of that, anyway? (rmail-output (expand-file-name token)))) - + ;; Functions for setting, getting and encoding the POP password. ;; The password is encoded to prevent it from being easily accessible ;; to "prying eyes." Obviously, this encoding isn't "real security," @@ -4300,6 +4300,85 @@ encoded string (and the same mask) will decode the string." (setq i (1+ i))) (concat string-vector))) +(defun rmail-epa-decrypt () + "Decrypt OpenPGP armors in current message." + (interactive) + + ;; Save the current buffer here for cleanliness, in case we + ;; change it in one of the calls to `epa-decrypt-region'. + + (save-excursion + (let (decrypts) + (goto-char (point-min)) + + ;; In case the encrypted data is inside a mime attachment, + ;; show it. This is a kludge; to be clean, it should not + ;; modify the buffer, but I don't see how to do that. + (when (search-forward "octet-stream" nil t) + (beginning-of-line) + (forward-button 1) + (if (looking-at "Show") + (rmail-mime-toggle-hidden))) + + ;; Now find all armored messages in the buffer + ;; and decrypt them one by one. + (goto-char (point-min)) + (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) + (let ((coding-system-for-read coding-system-for-read) + armor-start armor-end after-end) + (setq armor-start (match-beginning 0) + armor-end (re-search-forward "^-----END PGP MESSAGE-----$" + nil t)) + (unless armor-end + (error "Encryption armor beginning has no matching end")) + (goto-char armor-start) + + ;; Because epa--find-coding-system-for-mime-charset not autoloaded. + (require 'epa) + + ;; Use the charset specified in the armor. + (unless coding-system-for-read + (if (re-search-forward "^Charset: \\(.*\\)" armor-end t) + (setq coding-system-for-read + (epa--find-coding-system-for-mime-charset + (intern (downcase (match-string 1))))))) + + ;; Advance over this armor. + (goto-char armor-end) + (setq after-end (- (point-max) armor-end)) + + ;; Decrypt it, maybe in place, maybe making new buffer. + (epa-decrypt-region + armor-start armor-end + ;; Call back this function to prepare the output. + (lambda () + (let ((inhibit-read-only t)) + (delete-region armor-start armor-end) + (goto-char armor-start) + (current-buffer)))) + + (push (list armor-start (- (point-max) after-end)) + decrypts))) + + (when (and decrypts (rmail-buffers-swapped-p)) + (when (y-or-n-p "Replace the original message? ") + (setq decrypts (nreverse decrypts)) + (let ((beg (rmail-msgbeg rmail-current-message)) + (end (rmail-msgend rmail-current-message)) + (from-buffer (current-buffer))) + (with-current-buffer rmail-view-buffer + (narrow-to-region beg end) + (goto-char (point-min)) + (dolist (d decrypts) + (if (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) + (let (armor-start armor-end) + (setq armor-start (match-beginning 0) + armor-end (re-search-forward "^-----END PGP MESSAGE-----$" + nil t)) + (when armor-end + (delete-region armor-start armor-end) + (insert-buffer-substring from-buffer (nth 0 d) (nth 1 d))))))))))))) + ;;;; Desktop support (defun rmail-restore-desktop-buffer (desktop-buffer-file-name @@ -4403,7 +4482,7 @@ With prefix argument N moves forward N messages with these labels. ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "a7d3e7205efa4e20ca9038c9b260ce83") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "2c8675d7c069c68bc36a4003b15448d1") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 597068562b..d335125558 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -426,7 +426,7 @@ The value is a vector [ INDEX HEADER TAGLINE BODY END], where "Insert a tag line for MIME-entity ENTITY. ITEM-LIST is a list of strings or button-elements (list) to be added to the tag line." - (insert "[") + (insert "\n[") (let ((tag (aref (rmail-mime-entity-tagline entity) 0))) (if (> (length tag) 0) (insert (substring tag 1) ":"))) (insert (car (rmail-mime-entity-type entity)) " ") @@ -439,7 +439,7 @@ to the tag line." (if (stringp item) (insert item) (apply 'insert-button item)))) - (insert "]\n")) + (insert "]\n\n")) (defun rmail-mime-update-tagline (entity) "Update the current tag line for MIME-entity ENTITY." diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index fe20ad921d..cb02a4b374 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -156,49 +156,6 @@ This is used by the default mail-sending commands. See also :version "24.1" :group 'sendmail) -(defvar sendmail-query-once-function 'query - "Either a function to send email, or the symbol `query'.") - -;;;###autoload -(defun sendmail-query-once () - "Send an email via `sendmail-query-once-function'. -If `sendmail-query-once-function' is `query', ask the user what -function to use, and then save that choice." - (when (equal sendmail-query-once-function 'query) - (let* ((default - (cond - ((or (and window-system (eq system-type 'darwin)) - (eq system-type 'windows-nt)) - 'mailclient-send-it) - ((and sendmail-program - (executable-find sendmail-program)) - 'sendmail-send-it))) - (function - (if (or (not default) - ;; We have detected no OS-level mail senders, or we - ;; have already configured smtpmail, so we use the - ;; internal SMTP service. - (and (boundp 'smtpmail-smtp-server) - smtpmail-smtp-server)) - 'smtpmail-send-it - ;; Query the user. - (unwind-protect - (progn - (pop-to-buffer "*Mail Help*") - (erase-buffer) - (insert "Sending mail from Emacs hasn't been set up yet.\n\n" - "Type `y' to configure outgoing SMTP, or `n' to use\n" - "the default mail sender on your system.\n\n" - "To change this again at a later date, customize the\n" - "`send-mail-function' variable.\n") - (goto-char (point-min)) - (if (y-or-n-p "Configure outgoing SMTP in Emacs? ") - 'smtpmail-send-it - default)) - (kill-buffer (current-buffer)))))) - (customize-save-variable 'sendmail-query-once-function function))) - (funcall sendmail-query-once-function)) - ;;;###autoload (defcustom mail-header-separator (purecopy "--text follows this line--") "Line used to separate headers from text in messages being composed." @@ -541,6 +498,51 @@ by Emacs.)") "Additional expressions to highlight in Mail mode.") +;;;###autoload +(defun sendmail-query-once () + "Query for `send-mail-function' and send mail with it. +This also saves the value of `send-mail-function' via Customize." + (let* ((mail-buffer (current-buffer)) + ;; Compute default mail sender, preferring smtpmail if it's + ;; already configured. + (default (cond + ((and (boundp 'smtpmail-smtp-server) + smtpmail-smtp-server) + 'smtpmail-send-it) + ((or (and window-system (eq system-type 'darwin)) + (eq system-type 'windows-nt)) + 'mailclient-send-it) + ((and sendmail-program + (executable-find sendmail-program)) + 'sendmail-send-it))) + (send-function (if (eq default 'smtpmail-send-it) + 'smtpmail-send-it))) + (unless send-function + ;; Query the user. + (with-temp-buffer + (rename-buffer "*Mail Help*" t) + (erase-buffer) + (insert "Emacs has not been set up for sending mail.\n +Type `y' to configure and use Emacs as a mail client, +or `n' to use your system's default mailer.\n +To change your decision later, customize `send-mail-function'.\n") + (goto-char (point-min)) + (display-buffer (current-buffer)) + (if (y-or-n-p "Set up Emacs for sending SMTP mail? ") + ;; FIXME: We should check and correct the From: field too. + (setq send-function 'smtpmail-send-it) + (setq send-function default)))) + (when send-function + (customize-save-variable 'send-mail-function send-function) + ;; HACK: Message mode stupidly has `message-send-mail-function', + ;; so we must update it too or sending again in the current + ;; Emacs session will still call `sendmail-query-once'. + (and (boundp 'message-send-mail-function) + (eq message-send-mail-function 'sendmail-query-once) + (customize-set-variable 'message-send-mail-function + send-function)) + (funcall send-function)))) + (defun sendmail-sync-aliases () (when mail-personal-alias-file (let ((modtime (nth 5 (file-attributes mail-personal-alias-file)))) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index cc46660712..544570a1bc 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -55,15 +55,12 @@ ;;; Code: (require 'sendmail) +(require 'auth-source) (autoload 'mail-strip-quoted-names "mail-utils") (autoload 'message-make-date "message") (autoload 'message-make-message-id "message") (autoload 'rfc2104-hash "rfc2104") -(autoload 'netrc-parse "netrc") -(autoload 'netrc-machine "netrc") -(autoload 'netrc-get "netrc") (autoload 'password-read "password-cache") -(autoload 'auth-source-search "auth-source") ;;; (defgroup smtpmail nil @@ -89,6 +86,12 @@ The default value would be \"smtp\" or 25." :type '(choice (integer :tag "Port") (string :tag "Service")) :group 'smtpmail) +(defcustom smtpmail-smtp-user nil + "User name to use when looking up credentials." + :version "24.1" + :type '(choice (const nil) string) + :group 'smtpmail) + (defcustom smtpmail-local-domain nil "Local domain name without a host name. If the function `system-name' returns the full internet address, @@ -487,12 +490,13 @@ The list is in preference order.") (let* ((mechs (cdr-safe (assoc 'auth supported-extensions))) (mech (car (smtpmail-intersection mechs smtpmail-auth-supported))) (auth-source-creation-prompts - '((user . "SMTP user at %h: ") + '((user . "SMTP user name for %h: ") (secret . "SMTP password for %u@%h: "))) (auth-info (car (auth-source-search :host host :port port + :user smtpmail-smtp-user :max 1 :require (and ask-for-password '(:user :secret)) @@ -502,6 +506,8 @@ The list is in preference order.") (save-function (and ask-for-password (plist-get auth-info :save-function))) ret) + (when (functionp password) + (setq password (funcall password))) (when (and user (not password)) ;; The user has stored the user name, but not the password, so @@ -513,6 +519,7 @@ The list is in preference order.") :max 1 :host host :port port + :user smtpmail-smtp-user :require '(:user :secret) :create t)) password (plist-get auth-info :secret))) @@ -589,15 +596,17 @@ The list is in preference order.") (defun smtpmail-query-smtp-server () (let ((server (read-string "Outgoing SMTP mail server: ")) - (ports '(587 "smtp")) + (ports '("smtp" 587)) stream port) (when (and smtpmail-smtp-server (not (member smtpmail-smtp-server ports))) (push smtpmail-smtp-server ports)) (while (and (not smtpmail-smtp-server) (setq port (pop ports))) - (when (setq stream (ignore-errors - (open-network-stream "smtp" nil server port))) + (when (setq stream (condition-case () + (open-network-stream "smtp" nil server port) + (quit nil) + (error nil))) (customize-save-variable 'smtpmail-smtp-server server) (customize-save-variable 'smtpmail-smtp-service port) (delete-process stream))) @@ -618,8 +627,6 @@ The list is in preference order.") (and mail-specify-envelope-from (mail-envelope-from)) user-mail-address)) - (coding-system-for-read 'binary) - (coding-system-for-write 'binary) response-code process-buffer result @@ -638,21 +645,23 @@ The list is in preference order.") (erase-buffer)) ;; open the connection to the server - (setq result - (open-network-stream - "smtpmail" process-buffer host port - :type smtpmail-stream-type - :return-list t - :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn)) - :end-of-command "^[0-9]+ .*\r\n" - :success "^2.*\n" - :always-query-capabilities t - :starttls-function - (lambda (capabilities) - (and (string-match "-STARTTLS" capabilities) - "STARTTLS\r\n")) - :client-certificate t - :use-starttls-if-possible t)) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (setq result + (open-network-stream + "smtpmail" process-buffer host port + :type smtpmail-stream-type + :return-list t + :capability-command (format "EHLO %s\r\n" (smtpmail-fqdn)) + :end-of-command "^[0-9]+ .*\r\n" + :success "^2.*\n" + :always-query-capabilities t + :starttls-function + (lambda (capabilities) + (and (string-match "-STARTTLS" capabilities) + "STARTTLS\r\n")) + :client-certificate t + :use-starttls-if-possible t))) ;; If we couldn't access the server at all, we give up. (unless (setq process (car result)) @@ -669,7 +678,7 @@ The list is in preference order.") (throw 'done (format "No greeting: %s" greeting))) (when (>= code 400) (throw 'done (format "Connection not allowed: %s" greeting)))) - + (with-current-buffer process-buffer (set-buffer-process-coding-system 'raw-text-unix 'raw-text-unix) (make-local-variable 'smtpmail-read-point) @@ -722,7 +731,7 @@ The list is in preference order.") (when (member 'xusr supported-extensions) (smtpmail-command-or-throw process (format "XUSR"))) - + ;; MAIL FROM:<sender> (let ((size-part (if (or (member 'size supported-extensions) @@ -761,7 +770,7 @@ The list is in preference order.") ) ((and auth-mechanisms (not ask-for-password) - (= (car result) 530)) + (eq (car result) 530)) ;; We got a "530 auth required", so we close and try ;; again, this time asking the user for a password. (smtpmail-send-command process "QUIT") @@ -788,6 +797,7 @@ The list is in preference order.") nil) ((and auth-mechanisms (not ask-for-password) + (integerp (car result)) (>= (car result) 550) (<= (car result) 554)) ;; We got a "550 relay not permitted" (or the like), |