If STARTTLS failed, then just open a normal connection.

[gnus] / lisp / proto-stream.el

diff --git a/lisp/proto-stream.el b/lisp/proto-stream.el
index 3826068..c1acf4b 100644 (file)
--- a/lisp/proto-stream.el
+++ b/lisp/proto-stream.el
@@ -36,7 +36,7 @@
 
 ;; Usage example:
 
-;; (open-proto-stream
+;; (open-protocol-stream
 ;;  "*nnimap*" buffer address port
 ;;  :type 'network
 ;;  :capability-command "1 CAPABILITY\r\n"
@@ -54,7 +54,7 @@
 (require 'starttls)
 (require 'format-spec)
 
-(defcustom proto-stream-always-use-starttls t
+(defcustom proto-stream-always-use-starttls (fboundp 'open-gnutls-stream)
   "If non-nil, always try to upgrade network connections with STARTTLS."
   :version "24.1"
   :type 'boolean
@@ -64,7 +64,7 @@
                  (proc type &optional priority-string trustfiles keyfiles))
 
 ;;;###autoload
-(defun open-proto-stream (name buffer host service &rest parameters)
+(defun open-protocol-stream (name buffer host service &rest parameters)
   "Open a network stream to HOST.
 The first four parameters have the same meaning as in
 `open-network-stream'.  The function returns a list where the
@@ -109,6 +109,7 @@ command to switch on STARTTLS otherwise."
         (stream (open-network-stream name buffer host service))
         (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)))
     (if (not capability-command)
        (list stream greeting nil)
@@ -119,11 +120,12 @@ command to switch on STARTTLS otherwise."
                       capabilities)))
        (cond
         ((or (not starttls-command)
-             (not proto-stream-always-use-starttls))
+             (and (not (eq type 'starttls))
+                  (not proto-stream-always-use-starttls)))
          ;; If this server doesn't support STARTTLS, but we have
          ;; requested it explicitly, then close the connection and
          ;; return nil.
-         (if (eq (cadr (memq :type parameters)) 'starttls)
+         (if (eq type 'starttls)
              (progn
                (delete-process stream)
                nil)
@@ -133,12 +135,29 @@ command to switch on STARTTLS otherwise."
              (executable-find "gnutls-cli"))
          (unless (fboundp 'open-gnutls-stream)
            (delete-process stream)
-           (setq stream (starttls-open-stream name buffer host service))
+           (let* ((starttls-use-gnutls t)
+                  (starttls-extra-arguments
+                   (if (eq type 'starttls)
+                       ;; When doing opportunistic TLS upgrades we
+                       ;; don't really care about the identity of the
+                       ;; peer.
+                       (cons "--insecure" starttls-extra-arguments)
+                     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)
-           (starttls-negotiate stream))
+           (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
@@ -150,7 +169,7 @@ command to switch on STARTTLS otherwise."
          (list stream greeting capabilities)))))))
 
 (defun proto-stream-command (stream command eoc)
-  (let ((start (with-current-buffer buffer (point-max))))
+  (let ((start (with-current-buffer (process-buffer stream) (point-max))))
     (process-send-string stream command)
     (proto-stream-get-response stream start eoc)))