;;; proto-stream.el --- negotiating TLS, STARTTLS and other connections
+
;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; "*nnimap*" buffer address port
;; :type 'network
;; :capability-command "1 CAPABILITY\r\n"
+;; :success " OK "
;; :starttls-function
;; (lambda (capabilities)
;; (if (not (string-match "STARTTLS" capabilities))
;;;###autoload
(defun open-protocol-stream (name buffer host service &rest parameters)
- "Open a network stream to HOST.
+ "Open a network stream to HOST, upgrading to STARTTLS if possible.
The first four parameters have the same meaning as in
`open-network-stream'. The function returns a list where the
first element is the stream, the second element is the greeting
The PARAMETERS is a keyword list that can have the following
values:
-:type -- either `network', `tls', `shell' or `starttls'. If
-omitted, the default is `network'.
+:type -- either `network', `network-only, `tls', `shell' or
+`starttls'. If omitted, the default is `network'. `network'
+will be opportunistically upgraded to STARTTLS if both the server
+and Emacs supports it. If you don't want STARTTLS upgrades, use
+`network-only'.
:end-of-command -- a regexp saying what the end of a command is.
This defaults to \"\\n\".
if it turns out that the server doesn't support STARTTLS, or the
command to switch on STARTTLS otherwise."
(let ((type (or (cadr (memq :type parameters)) 'network)))
- (when (and (eq type 'starttls)
- (fboundp 'open-gnutls-stream))
+ (cond
+ ((eq type 'starttls)
(setq type 'network))
- (when (eq type 'ssl)
- (setq type 'tls))
+ ((eq type 'ssl)
+ (setq type 'tls)))
(destructuring-bind (stream greeting capabilities)
(funcall (intern (format "proto-stream-open-%s" type) obarray)
name buffer host service parameters)
stream)
greeting capabilities))))
+(defun proto-stream-open-network-only (name buffer host service parameters)
+ (let ((start (with-current-buffer buffer (point)))
+ (stream (open-network-stream name buffer host service)))
+ (list stream
+ (proto-stream-get-response
+ stream start (proto-stream-eoc parameters))
+ nil)))
+
(defun proto-stream-open-network (name buffer host service parameters)
(let* ((start (with-current-buffer buffer (point)))
(stream (open-network-stream name buffer host service))
(funcall (cadr (memq :starttls-function parameters))
capabilities)))
(cond
- ((or (not starttls-command)
- (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.
+ ((or (not starttls-command)
+ (and (not (eq type 'starttls))
+ (not proto-stream-always-use-starttls)))
(if (eq type 'starttls)
(progn
(delete-process stream)
nil)
;; Otherwise, just return this plain network connection.
(list stream greeting capabilities)))
+ ;; We have some kind of STARTTLS support, so we try to
+ ;; upgrade the connection opportunistically.
((or (fboundp 'open-gnutls-stream)
(executable-find "gnutls-cli"))
(unless (fboundp 'open-gnutls-stream)
;; after switching to TLS.
(list stream greeting
(proto-stream-command stream capability-command eoc))))
+ ;; We don't have STARTTLS support available, but the caller
+ ;; requested a STARTTLS connection, so we give up.
((eq (cadr (memq :type parameters)) 'starttls)
(delete-process stream)
nil)
+ ;; Fall back on using a plain network stream.
(t
(list stream greeting capabilities)))))))
'open-gnutls-stream
'open-tls-stream)
name buffer host service)))
- ;; If we're using tls.el, we have to delete the output from
- ;; openssl/gnutls-cli.
- (unless (fboundp 'open-gnutls-stream)
- (proto-stream-get-response
- stream start (proto-stream-eoc parameters))
- (goto-char (point-min))
- (when (re-search-forward (proto-stream-eoc parameters) nil t)
- (goto-char (match-beginning 0))
- (delete-region (point-min) (line-beginning-position))))
- (proto-stream-capability-open start stream parameters))))
+ (if (null stream)
+ nil
+ ;; If we're using tls.el, we have to delete the output from
+ ;; openssl/gnutls-cli.
+ (unless (fboundp 'open-gnutls-stream)
+ (proto-stream-get-response
+ stream start (proto-stream-eoc parameters))
+ (goto-char (point-min))
+ (when (re-search-forward (proto-stream-eoc parameters) nil t)
+ (goto-char (match-beginning 0))
+ (delete-region (point-min) (line-beginning-position))))
+ (proto-stream-capability-open start stream parameters)))))
(defun proto-stream-open-shell (name buffer host service parameters)
(proto-stream-capability-open