X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/51751aa26f9935609630f04e781a954b54ecc82e..e233e1000e6982f37c196dbd6b0f654ba61ffa08:/lisp/net/network-stream.el diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index 0c3d0285f9..fd21997ba2 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -1,6 +1,6 @@ ;;; network-stream.el --- open network processes, possibly with encryption -;; Copyright (C) 2010-2011 Free Software Foundation, Inc. +;; Copyright (C) 2010-2013 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: network @@ -115,7 +115,7 @@ values: capability command, and should return the command to switch on STARTTLS if the server supports STARTTLS, and nil otherwise. -:always-query-capabilies says whether to query the server for +:always-query-capabilities says whether to query the server for capabilities, even if we're doing a `plain' network connection. :client-certificate should either be a list where the first @@ -125,9 +125,8 @@ values: certificate. This parameter will only be used when doing TLS or STARTTLS connections. -If :use-starttls-if-possible is non-nil, do opportunistic -STARTTLS upgrades even if Emacs doesn't have built-in TLS -functionality. +:use-starttls-if-possible is a boolean that says to do opportunistic +STARTTLS upgrades even if Emacs doesn't have built-in TLS functionality. :nowait is a boolean that says the connection should be made asynchronously, if possible." @@ -218,7 +217,7 @@ functionality. (resulting-type 'plain) (builtin-starttls (and (fboundp 'gnutls-available-p) (gnutls-available-p))) - starttls-command error) + starttls-available starttls-command error) ;; First check whether the server supports STARTTLS at all. (when (and capabilities success-string starttls-function) @@ -227,10 +226,11 @@ functionality. ;; If we have built-in STARTTLS support, try to upgrade the ;; connection. (when (and starttls-command - (or builtin-starttls - (and (or require-tls - (plist-get parameters :use-starttls-if-possible)) - (starttls-available-p))) + (setq starttls-available + (or builtin-starttls + (and (or require-tls + (plist-get parameters :use-starttls-if-possible)) + (starttls-available-p)))) (not (eq (plist-get parameters :type) 'plain))) ;; If using external STARTTLS, drop this connection and start ;; anew with `starttls-open-stream'. @@ -262,8 +262,9 @@ functionality. ;; EHLO for SMTP. (when (plist-get parameters :always-query-capabilities) (network-stream-command stream capability-command eo-capa))) - (when (string-match success-string - (network-stream-command stream starttls-command eoc)) + (when (let ((response + (network-stream-command stream starttls-command eoc))) + (and response (string-match success-string response))) ;; The server said it was OK to begin STARTTLS negotiations. (if builtin-starttls (let ((cert (network-stream-certificate host service parameters))) @@ -298,9 +299,19 @@ functionality. ;; support, or no gnutls-cli installed. (eq resulting-type 'plain)) (setq error - (if require-tls + (if (or (null starttls-command) + starttls-available) "Server does not support TLS" - "Server supports STARTTLS, but Emacs does not have support for it")) + ;; See `starttls-available-p'. If this predicate + ;; changes to allow running under Windows, the error + ;; message below should be amended. + (if (memq system-type '(windows-nt ms-dos)) + (concat "Emacs does not support TLS") + (concat "Emacs does not support TLS, and no external `" + (if starttls-use-gnutls + starttls-gnutls-program + starttls-program) + "' program was found")))) (delete-process stream) (setq stream nil)) ;; Return value: