Commit ccedc679 authored by Stefan Monnier's avatar Stefan Monnier

* lisp/mail/smtpmail.el: Use lexical-binding and cl-generic

(smtpmail-auth-supported): Mark it as non-constant.
(smtpmail-try-auth-methods): Remove unused var 'ret'.
Test non-nullness of mech user and password before calling
smtpmail-try-auth-method.
(smtpmail-try-auth-method): Make it into a generic function.
(smtpmail-via-smtp): Remove unused var 'response-code'.
parent fe15532e
......@@ -88,6 +88,10 @@ strings in non-text modes.
* Changes in Specialized Modes and Packages in Emacs 27.1
** Smtpmail
Authentication mechanisms can be added via external packages, by
defining new cl-defmethod of smtpmail-try-auth-method.
** Footnote-mode
*** Support Hebrew-style footnotes
*** Footnote text lines are now aligned.
......
;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail -*- lexical-binding:t -*-
;; Copyright (C) 1995-1996, 2001-2018 Free Software Foundation, Inc.
......@@ -138,7 +138,7 @@ The commands enables verbose information from the SMTP server."
(defcustom smtpmail-code-conv-from nil
"Coding system for encoding outgoing mail.
Used for the value of `sendmail-coding-system' when
`select-message-coding-system' is called. "
`select-message-coding-system' is called."
:type 'coding-system
:group 'smtpmail)
......@@ -179,9 +179,11 @@ This is relative to `smtpmail-queue-dir'."
;; Buffer-local variable.
(defvar smtpmail-read-point)
(defconst smtpmail-auth-supported '(cram-md5 plain login)
(defvar smtpmail-auth-supported '(cram-md5 plain login)
"List of supported SMTP AUTH mechanisms.
The list is in preference order.")
The list is in preference order.
Every element should have a matching `cl-defmethod' for
for `smtpmail-try-auth-method'.")
(defvar smtpmail-mail-address nil
"Value to use for envelope-from address for mail from ambient buffer.")
......@@ -508,8 +510,7 @@ The list is in preference order.")
(user (plist-get auth-info :user))
(password (plist-get auth-info :secret))
(save-function (and ask-for-password
(plist-get auth-info :save-function)))
ret)
(plist-get auth-info :save-function))))
(when (functionp password)
(setq password (funcall password)))
(when (and user
......@@ -530,7 +531,10 @@ The list is in preference order.")
(when (functionp password)
(setq password (funcall password)))
(let ((result (catch 'done
(smtpmail-try-auth-method process mech user password))))
(if (and mech user password)
(smtpmail-try-auth-method process mech user password)
;; No mechanism, or no credentials.
mech))))
(if (stringp result)
(progn
(auth-source-forget+ :host host :port port)
......@@ -539,51 +543,52 @@ The list is in preference order.")
(funcall save-function))
result))))
(defun smtpmail-try-auth-method (process mech user password)
(let (ret)
(cond
((or (not mech)
(not user)
(not password))
;; No mechanism, or no credentials.
mech)
((eq mech 'cram-md5)
(setq ret (smtpmail-command-or-throw process "AUTH CRAM-MD5"))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
(decoded (base64-decode-string challenge))
(hash (rfc2104-hash 'md5 64 16 password decoded))
(response (concat user " " hash))
;; Osamu Yamane <yamane@green.ocn.ne.jp>:
;; SMTP auth fails because the SMTP server identifies
;; only the first part of the string (delimited by
;; new line characters) as a response from the
;; client, and the rest as distinct commands.
;; In my case, the response string is 80 characters
;; long. Without the no-line-break option for
;; `base64-encode-string', only the first 76 characters
;; are taken as a response to the server, and the
;; authentication fails.
(encoded (base64-encode-string response t)))
(smtpmail-command-or-throw process encoded))))
((eq mech 'login)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t)))
((eq mech 'plain)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
;; is not sent if the server did not advertise AUTH PLAIN in
;; the EHLO response. See RFC 2554 for more info.
(smtpmail-command-or-throw
process
(concat "AUTH PLAIN "
(base64-encode-string (concat "\0" user "\0" password) t))
235))
(t
(error "Mechanism %s not implemented" mech)))))
(cl-defgeneric smtpmail-try-auth-method (_process mech _user _password)
"Perform authentication of type MECH for USER with PASSWORD.
MECH should be one of the values in `smtpmail-auth-supported'.
USER and PASSWORD should be non-nil."
(error "Mechanism %S not implemented" mech))
(cl-defmethod smtpmail-try-auth-method
(process (_mech (eql cram-md5)) user password)
(let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
(decoded (base64-decode-string challenge))
(hash (rfc2104-hash 'md5 64 16 password decoded))
(response (concat user " " hash))
;; Osamu Yamane <yamane@green.ocn.ne.jp>:
;; SMTP auth fails because the SMTP server identifies
;; only the first part of the string (delimited by
;; new line characters) as a response from the
;; client, and the rest as distinct commands.
;; In my case, the response string is 80 characters
;; long. Without the no-line-break option for
;; `base64-encode-string', only the first 76 characters
;; are taken as a response to the server, and the
;; authentication fails.
(encoded (base64-encode-string response t)))
(smtpmail-command-or-throw process encoded)))))
(cl-defmethod smtpmail-try-auth-method
(process (_mech (eql login)) user password)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t)))
(cl-defmethod smtpmail-try-auth-method
(process (_mech (eql plain)) user password)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
;; is not sent if the server did not advertise AUTH PLAIN in
;; the EHLO response. See RFC 2554 for more info.
(smtpmail-command-or-throw
process
(concat "AUTH PLAIN "
(base64-encode-string (concat "\0" user "\0" password) t))
235))
(defun smtpmail-response-code (string)
(when string
......@@ -662,7 +667,6 @@ Returns an error if the server cannot be contacted."
(and from
(cadr (mail-extract-address-components from))))
(smtpmail-user-mail-address)))
response-code
process-buffer
result
auth-mechanisms
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment