[Emacs-diffs] /srv/bzr/emacs/trunk r104740: If the SMTP server supports STARTTLS, but Emacs has no built-in or

[Lars Magne Ingebrigtsen]

------------------------------------------------------------
revno: 104740
committer: Lars Magne Ingebrigtsen <address@hidden>
branch nick: trunk
timestamp: Sun 2011-06-26 23:05:06 +0200
message:
  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.
modified:
  lisp/ChangeLog
  lisp/mail/smtpmail.el
  lisp/net/network-stream.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-06-26 20:25:53 +0000
+++ b/lisp/ChangeLog    2011-06-26 21:05:06 +0000
@@ -1,3 +1,16 @@
+2011-06-26  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * 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  <address@hidden>
 
        * hl-line.el (hl-line-sticky-flag): Doc fix.

=== modified file 'lisp/mail/smtpmail.el'
--- a/lisp/mail/smtpmail.el     2011-06-22 19:24:51 +0000
+++ b/lisp/mail/smtpmail.el     2011-06-26 21:05:06 +0000
@@ -651,7 +651,9 @@
 
          ;; 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)

=== modified file 'lisp/net/network-stream.el'
--- a/lisp/net/network-stream.el        2011-06-26 08:13:07 +0000
+++ b/lisp/net/network-stream.el        2011-06-26 21:05:06 +0000
@@ -162,7 +162,8 @@
            (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 @@
         (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 @@
              (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