]> git.eshelyaron.com Git - emacs.git/commitdiff
If the SMTP server supports STARTTLS, but Emacs has no built-in or
authorLars Magne Ingebrigtsen <larsi@gnus.org>
Sun, 26 Jun 2011 21:05:06 +0000 (23:05 +0200)
committerLars Magne Ingebrigtsen <larsi@gnus.org>
Sun, 26 Jun 2011 21:05:06 +0000 (23:05 +0200)
external STARTTLS support, then report this in a sensible fashion to
the user.

lisp/ChangeLog
lisp/mail/smtpmail.el
lisp/net/network-stream.el

index 23699cb44ac5470c7f148e65c3cb1e8774103254..98b5ac37ef28af48a0c93c024865b53084fc09b6 100644 (file)
@@ -1,3 +1,16 @@
+2011-06-26  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * 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  <cyd@stupidchicken.com>
 
        * hl-line.el (hl-line-sticky-flag): Doc fix.
index 3c9ea9de5738b9ede472665c3a5a374f31623fd7..4a3cb90657014ca888a1c863a9a4deb28fbdda26 100644 (file)
@@ -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)
index 94507f165407bfe792f1106b37e94f19a058822c..502d77500ab1f92e42b4525f71bea3d2162ff3b0 100644 (file)
@@ -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