From 468d09d44ee9652802712053b0fc259891c431b7 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Sun, 26 Jun 2011 23:05:06 +0200 Subject: [PATCH] If the SMTP server supports STARTTLS, but Emacs has no built-in or external STARTTLS support, then report this in a sensible fashion to the user. --- lisp/ChangeLog | 13 +++++++++++++ lisp/mail/smtpmail.el | 4 +++- lisp/net/network-stream.el | 36 +++++++++++++++++++++++++----------- 3 files changed, 41 insertions(+), 12 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 23699cb44ac..98b5ac37ef2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2011-06-26 Lars Magne Ingebrigtsen + + * net/network-stream.el (open-network-stream): Return an :error + saying what the problem was, if possible. + + * mail/smtpmail.el (smtpmail-via-smtp): Report the error from the + server. + + * net/network-stream.el (network-stream-open-starttls): If we + wanted to use STARTTLS, and the server offered it, but we weren't + able to because we had no STARTTLS support, then close the connection. + (open-network-stream): Return an :error element, if present. + 2011-06-26 Chong Yidong * hl-line.el (hl-line-sticky-flag): Doc fix. diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 3c9ea9de573..4a3cb906570 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -651,7 +651,9 @@ The list is in preference order.") ;; If we couldn't access the server at all, we give up. (unless (setq process (car result)) - (throw 'done "Unable to contact server")) + (throw 'done (if (plist-get (cdr result) :error) + (plist-get (cdr result) :error) + "Unable to contact server"))) ;; set the send-filter (set-process-filter process 'smtpmail-process-filter) diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 94507f16540..502d77500ab 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -162,7 +162,8 @@ functionality. (list (car result) :greeting (nth 1 result) :capabilities (nth 2 result) - :type (nth 3 result)) + :type (nth 3 result) + :error (nth 4 result)) (car result)))))) (defun network-stream-certificate (host service parameters) @@ -210,17 +211,19 @@ functionality. (resulting-type 'plain) (builtin-starttls (and (fboundp 'gnutls-available-p) (gnutls-available-p))) - starttls-command) + starttls-command error) + ;; First check whether the server supports STARTTLS at all. + (when (and capabilities success-string starttls-function) + (setq starttls-command + (funcall starttls-function capabilities))) ;; If we have built-in STARTTLS support, try to upgrade the ;; connection. - (when (and (or builtin-starttls + (when (and starttls-command + (or builtin-starttls (and (or require-tls (plist-get parameters :use-starttls-if-possible)) - (executable-find "gnutls-cli"))) - capabilities success-string starttls-function - (setq starttls-command - (funcall starttls-function capabilities)) + (executable-find "gnutls-clii"))) (not (eq (plist-get parameters :type) 'plain))) ;; If using external STARTTLS, drop this connection and start ;; anew with `starttls-open-stream'. @@ -271,11 +274,22 @@ functionality. (network-stream-command stream capability-command eoc)))) ;; If TLS is mandatory, close the connection if it's unencrypted. - (and require-tls - (eq resulting-type 'plain) - (delete-process stream)) + (when (and (or require-tls + ;; The server said it was possible to do STARTTLS, + ;; and we wanted to use it... + (and starttls-command + (plist-get parameters :use-starttls-if-possible))) + ;; ... but Emacs wasn't able to -- either no built-in + ;; support, or no gnutls-cli installed. + (eq resulting-type 'plain)) + (setq error + (if require-tls + "Server does not support TLS" + "Server supports STARTTLS, but Emacs does not have support for it")) + (delete-process stream) + (setq stream nil)) ;; Return value: - (list stream greeting capabilities resulting-type))) + (list stream greeting capabilities resulting-type error))) (defun network-stream-command (stream command eoc) (when command -- 2.39.2