From 184ab343047ce20af5af38d2163f7d0a3e3bd0d5 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Sun, 28 Nov 2010 10:16:42 +0100 Subject: [PATCH] See what the response to the STARTTLS command is. --- lisp/ChangeLog | 7 ++++++ lisp/nnimap.el | 1 + lisp/nntp.el | 1 + lisp/proto-stream.el | 53 ++++++++++++++++++++++++++++---------------- 4 files changed, 43 insertions(+), 19 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index e75717b09..f27b3e3d0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2010-11-28 Lars Magne Ingebrigtsen + * 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 38f8004f4..c802a0597 100644 --- 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 c0206106c..6504f05c9 100644 --- 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 e80d38b3c..19e932ba5 100644 --- 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) -- 2.25.1