;;; network-stream.el --- open network processes, possibly with encryption
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2015 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
(require 'tls)
(require 'starttls)
(require 'auth-source)
+(require 'nsm)
(autoload 'gnutls-negotiate "gnutls")
(autoload 'open-gnutls-stream "gnutls")
:end-of-command specifies a regexp matching the end of a command.
+:end-of-capability specifies a regexp matching the end of the
+ response to the command specified for :capability-command.
+ It defaults to the regexp specified for :end-of-command.
+
:success specifies a regexp matching a message indicating a
successful STARTTLS negotiation. For instance, the default
should be \"^3\" for an NNTP connection.
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
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.
+
+:warn-unless-encrypted is a boolean which, if :return-list is
+non-nil, is used warn the user if the connection isn't encrypted.
+
+:nogreeting is a boolean that can be used to inhibit waiting for
+a greeting from the server.
:nowait is a boolean that says the connection should be made
- asynchronously, if possible."
+asynchronously, if possible."
(unless (featurep 'make-network-process)
(error "Emacs was compiled without networking support"))
(let ((type (plist-get parameters :type))
(stream (make-network-process :name name :buffer buffer
:host host :service service
:nowait (plist-get parameters :nowait))))
+ (when (plist-get parameters :warn-unless-encrypted)
+ (setq stream (nsm-verify-connection stream host service nil t)))
(list stream
(network-stream-get-response stream start
(plist-get parameters :end-of-command))
(success-string (plist-get parameters :success))
(capability-command (plist-get parameters :capability-command))
(eoc (plist-get parameters :end-of-command))
+ (eo-capa (or (plist-get parameters :end-of-capability)
+ eoc))
;; Return (STREAM GREETING CAPABILITIES RESULTING-TYPE)
(stream (make-network-process :name name :buffer buffer
:host host :service service))
- (greeting (network-stream-get-response stream start eoc))
- (capabilities (network-stream-command stream capability-command eoc))
+ (greeting (and (not (plist-get parameters :nogreeting))
+ (network-stream-get-response stream start eoc)))
+ (capabilities (network-stream-command stream capability-command
+ eo-capa))
(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)
;; 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))
- (executable-find "gnutls-clii")))
+ (setq starttls-available
+ (or (gnutls-available-p)
+ (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'.
- (unless builtin-starttls
+ (unless (gnutls-available-p)
(delete-process stream)
(setq start (with-current-buffer buffer (point-max)))
- (let* ((starttls-use-gnutls t)
- (starttls-extra-arguments
- (if require-tls
+ (let* ((starttls-extra-arguments
+ (if (or require-tls
+ (member "--insecure" starttls-extra-arguments))
starttls-extra-arguments
;; For opportunistic TLS upgrades, we don't really
;; care about the identity of the peer.
(cons "--insecure" starttls-extra-arguments)))
+ (starttls-extra-args starttls-extra-args)
(cert (network-stream-certificate host service parameters)))
;; There are client certificates requested, so add them to
;; the command line.
(setq starttls-extra-arguments
(nconc (list "--x509keyfile" (expand-file-name (nth 0 cert))
"--x509certfile" (expand-file-name (nth 1 cert)))
- starttls-extra-arguments)))
+ starttls-extra-arguments)
+ starttls-extra-args
+ (nconc (list "--key-file" (expand-file-name (nth 0 cert))
+ "--cert-file" (expand-file-name (nth 1 cert)))
+ starttls-extra-args)))
(setq stream (starttls-open-stream name buffer host service)))
- (network-stream-get-response stream start eoc))
- ;; Requery capabilities for protocols that require it; i.e.,
- ;; EHLO for SMTP.
- (when (plist-get parameters :always-query-capabilities)
- (network-stream-command stream capability-command eoc))
- (when (string-match success-string
- (network-stream-command stream starttls-command eoc))
+ (network-stream-get-response stream start eoc)
+ ;; Requery capabilities for protocols that require it; i.e.,
+ ;; EHLO for SMTP.
+ (when (plist-get parameters :always-query-capabilities)
+ (network-stream-command stream capability-command eo-capa)))
+ (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
+ (if (gnutls-available-p)
(let ((cert (network-stream-certificate host service parameters)))
- (gnutls-negotiate :process stream :hostname host
- :keylist (and cert (list cert))))
+ (condition-case nil
+ (gnutls-negotiate :process stream :hostname host
+ :keylist (and cert (list cert)))
+ ;; If we get a gnutls-specific error (for instance if
+ ;; the certificate the server gives us is completely
+ ;; syntactically invalid), then close the connection
+ ;; and possibly (further down) try to create a
+ ;; non-encrypted connection.
+ (gnutls-error
+ (delete-process stream))))
(unless (starttls-negotiate stream)
(delete-process stream)))
(if (memq (process-status stream) '(open run))
(network-stream-get-response stream start eoc)))
;; Re-get the capabilities, which may have now changed.
(setq capabilities
- (network-stream-command stream capability-command eoc))))
+ (network-stream-command stream capability-command eo-capa))))
;; If TLS is mandatory, close the connection if it's unencrypted.
- (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)))
+ (when (and require-tls
;; ... 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"))
+ (setq error
+ (if (or (null starttls-command)
+ starttls-available)
+ "Server does not support TLS"
+ ;; 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))
+ ;; Check certificate validity etc.
+ (when (gnutls-available-p)
+ (setq stream (nsm-verify-connection
+ stream host service
+ (eq resulting-type 'tls)
+ (plist-get parameters :warn-unless-encrypted))))
;; Return value:
(list stream greeting capabilities resulting-type error)))
(defun network-stream-open-tls (name buffer host service parameters)
(with-current-buffer buffer
(let* ((start (point-max))
- (use-builtin-gnutls (and (fboundp 'gnutls-available-p)
- (gnutls-available-p)))
(stream
- (funcall (if use-builtin-gnutls
+ (funcall (if (gnutls-available-p)
'open-gnutls-stream
'open-tls-stream)
name buffer host service))
(eoc (plist-get parameters :end-of-command)))
+ ;; Check certificate validity etc.
+ (when (and (gnutls-available-p) stream)
+ (setq stream (nsm-verify-connection stream host service)))
(if (null stream)
(list nil nil nil 'plain)
;; If we're using tls.el, we have to delete the output from
;; openssl/gnutls-cli.
- (when (and (null use-builtin-gnutls)
+ (when (and (not (gnutls-available-p))
eoc)
(network-stream-get-response stream start eoc)
(goto-char (point-min))
?p service))))))
(list stream
(network-stream-get-response stream start eoc)
- (network-stream-command stream capability-command eoc)
+ (network-stream-command stream capability-command
+ (or (plist-get parameters :end-of-capability)
+ eoc))
'plain)))
(provide 'network-stream)