See what the response to the STARTTLS command is.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e75717b..f27b3e3 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,12 @@
 2010-11-28  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
+       * nntp.el (nntp-open-connection): Provide a :success condition.
+
+       * nnimap.el (nnimap-open-connection-1): Ditto.
+
+       * proto-stream.el (proto-stream-open-network): See what the response to
+       the STARTTLS command is.
+
        * nnimap.el (nnimap-open-connection-1): Always upgrade to STARTTLS (for
        backwards compatibility).
        (nnimap-open-connection-1): Really respect nnimap-server-port.

diff --git a/lisp/nnimap.el b/lisp/nnimap.el
index 38f8004..c802a05 100644 (file)
--- a/lisp/nnimap.el
+++ b/lisp/nnimap.el
@@ -355,6 +355,7 @@ textual parts.")
           :type nnimap-stream
           :shell-command nnimap-shell-program
           :capability-command "1 CAPABILITY\r\n"
+          :success " OK "
           :starttls-function
           (lambda (capabilities)
             (if (not (string-match "STARTTLS" capabilities))

diff --git a/lisp/nntp.el b/lisp/nntp.el
index c020610..6504f05 100644 (file)
--- a/lisp/nntp.el
+++ b/lisp/nntp.el
@@ -1275,6 +1275,7 @@ password contained in '~/.nntp-authinfo'."
                                 (assoc nntp-open-connection-function map))
                          :end-of-command "^\\([2345]\\|[.]\\).*\n"
                          :capability-command "CAPABILITIES\r\n"
+                         :success "^3"
                          :starttls-function
                          (lambda (capabilities)
                            (if (not (string-match "STARTTLS" capabilities))

diff --git a/lisp/proto-stream.el b/lisp/proto-stream.el
index e80d38b..19e932b 100644 (file)
--- a/lisp/proto-stream.el
+++ b/lisp/proto-stream.el
@@ -81,6 +81,9 @@ omitted, the default is `network'.
 :end-of-command -- a regexp saying what the end of a command is.
 This defaults to \"\\n\".
 
+:success -- a regexp saying whether the STARTTLS command was
+successful or not.  For instance, for NNTP this is \"^3\".
+
 :capability-command -- a string representing the command used to
 query server for capabilities.  For instance, for IMAP this is
 \"1 CAPABILITY\\r\\n\".
@@ -110,7 +113,8 @@ command to switch on STARTTLS otherwise."
         (capability-command (cadr (memq :capability-command parameters)))
         (eoc (proto-stream-eoc parameters))
         (type (cadr (memq :type parameters)))
-        (greeting (proto-stream-get-response stream start eoc)))
+        (greeting (proto-stream-get-response stream start eoc))
+        success)
     (if (not capability-command)
        (list stream greeting nil)
       (let* ((capabilities
@@ -138,7 +142,7 @@ command to switch on STARTTLS otherwise."
            (setq start (with-current-buffer buffer (point-max)))
            (let* ((starttls-use-gnutls t)
                   (starttls-extra-arguments
-                   (if (eq type 'starttls)
+                   (if (not (eq type 'starttls))
                        ;; When doing opportunistic TLS upgrades we
                        ;; don't really care about the identity of the
                        ;; peer.
@@ -146,23 +150,34 @@ command to switch on STARTTLS otherwise."
                      starttls-extra-arguments)))
              (setq stream (starttls-open-stream name buffer host service)))
            (proto-stream-get-response stream start eoc))
-         (proto-stream-command stream starttls-command eoc)
-         (if (fboundp 'open-gnutls-stream)
-             (gnutls-negotiate stream nil)
-           (unless (starttls-negotiate stream)
-             (delete-process stream)
-             (setq stream nil)))
-         (when (or (null stream)
-                   (not (memq (process-status stream)
-                              '(open run))))
-           ;; It didn't successfully negotiate STARTTLS, so we reopen
-           ;; the connection.
-           (setq stream (open-network-stream name buffer host service))
-           (proto-stream-get-response stream start eoc))
-         ;; Re-get the capabilities, since they may have changed
-         ;; after switching to TLS.
-         (list stream greeting
-               (proto-stream-command stream capability-command eoc)))
+         (if (not
+              (string-match
+               (cadr (memq :success parameters))
+               (proto-stream-command stream starttls-command eoc)))
+             ;; We got an error back from the STARTTLS command.
+             (progn
+               (if (eq type 'starttls)
+                   (progn
+                     (delete-process stream)
+                     nil)
+                 (list stream greeting capabilities)))
+           ;; The server said it was OK to start doing STARTTLS negotiations.
+           (if (fboundp 'open-gnutls-stream)
+               (gnutls-negotiate stream nil)
+             (unless (starttls-negotiate stream)
+               (delete-process stream)
+               (setq stream nil)))
+           (when (or (null stream)
+                     (not (memq (process-status stream)
+                                '(open run))))
+             ;; It didn't successfully negotiate STARTTLS, so we reopen
+             ;; the connection.
+             (setq stream (open-network-stream name buffer host service))
+             (proto-stream-get-response stream start eoc))
+           ;; Re-get the capabilities, since they may have changed
+           ;; after switching to TLS.
+           (list stream greeting
+                 (proto-stream-command stream capability-command eoc))))
         ((eq (cadr (memq :type parameters)) 'starttls)
          (delete-process stream)
          nil)