;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
-;; Copyright (C) 2010-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
(require 'tls)
(require 'starttls)
-(declare-function gnutls-negotiate "gnutls" t t) ; defun*
+(autoload 'gnutls-negotiate "gnutls")
+(autoload 'open-gnutls-stream "gnutls")
;;;###autoload
(defun open-protocol-stream (name buffer host service &rest parameters)
:end-of-command specifies a regexp matching the end of a command.
If non-nil, it defaults to \"\\n\".
+: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.
(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 (open-network-stream name buffer host service))
(greeting (proto-stream-get-response stream start eoc))
(capabilities (when capability-command
(proto-stream-command stream
- capability-command eoc)))
+ capability-command
+ (or eo-capa eoc))))
(resulting-type 'plain)
+ (builtin-starttls (and (fboundp 'gnutls-available-p)
+ (gnutls-available-p)))
starttls-command)
;; If we have built-in STARTTLS support, try to upgrade the
;; connection.
- (when (and (or (fboundp 'open-gnutls-stream)
+ (when (and (or builtin-starttls
(and require-tls
(executable-find "gnutls-cli")))
capabilities success-string starttls-function
(funcall starttls-function capabilities)))
;; If using external STARTTLS, drop this connection and start
;; anew with `starttls-open-stream'.
- (unless (fboundp 'open-gnutls-stream)
+ (unless builtin-starttls
(delete-process stream)
(setq start (with-current-buffer buffer (point-max)))
(let* ((starttls-use-gnutls t)
(when (string-match success-string
(proto-stream-command stream starttls-command eoc))
;; The server said it was OK to begin STARTTLS negotiations.
- (if (fboundp 'open-gnutls-stream)
+ (if builtin-starttls
(gnutls-negotiate :process stream :hostname host)
(unless (starttls-negotiate stream)
(delete-process stream)))
(proto-stream-get-response stream start eoc)))
;; Re-get the capabilities, which may have now changed.
(setq capabilities
- (proto-stream-command stream capability-command eoc))))
+ (proto-stream-command stream capability-command eo-capa))))
;; If TLS is mandatory, close the connection if it's unencrypted.
(and require-tls
(defun proto-stream-open-tls (name buffer host service parameters)
(with-current-buffer buffer
- (let ((start (point-max))
- (stream
- (funcall (if (fboundp 'open-gnutls-stream)
- 'open-gnutls-stream
- 'open-tls-stream)
- name buffer host service))
- (eoc (plist-get parameters :end-of-command)))
+ (let* ((start (point-max))
+ (builtin-starttls (and (fboundp 'gnutls-available-p)
+ (gnutls-available-p)))
+ (stream
+ (funcall (if builtin-starttls
+ 'open-gnutls-stream
+ 'open-tls-stream)
+ name buffer host service))
+ (eoc (plist-get parameters :end-of-command)))
(if (null stream)
(list nil nil nil 'plain)
;; If we're using tls.el, we have to delete the output from
;; openssl/gnutls-cli.
- (unless (fboundp 'open-gnutls-stream)
+ (unless builtin-starttls
(proto-stream-get-response stream start eoc)
(goto-char (point-min))
(when (re-search-forward eoc nil t)
(defun proto-stream-capability-open (start stream parameters stream-type)
(let* ((capability-command (plist-get parameters :capability-command))
- (eoc (plist-get parameters :end-of-command))
- (greeting (proto-stream-get-response stream start eoc)))
+ (greeting (proto-stream-get-response
+ stream start
+ (plist-get parameters :end-of-command))))
(list stream greeting
(and capability-command
- (proto-stream-command stream capability-command eoc))
+ (proto-stream-command
+ stream capability-command
+ (or
+ (plist-get parameters :end-of-capability)
+ (plist-get parameters :end-of-command))))
stream-type)))
(provide 'proto-stream)