+2003-03-23 Simon Josefsson <jas@extundo.com>
+
+ * tls.el: New file.
+
+ * nnimap.el (nnimap-server-port, nnimap-stream): Say TLS/SSL
+ instead of SSL.
+ (nnimap-stream): Add other streams, link to imap variables.
+ (nnimap-authenticator): Add other authenticator, link to imap
+ variables.
+
+ * imap.el: Autoload open-tls-stream.
+ (imap-streams): Add tls in front of ssl.
+ (imap-stream-alist): Add tls.
+ (imap-default-tls-port): New variable.
+ (imap-tls-p, imap-tls-open): New functions.
+
2003-03-22 ShengHuo ZHU <zsh@cs.rochester.edu>
* mm-url.el (mm-url-insert-file-contents): parse url only if
(autoload 'utf7-decode "utf7")
(autoload 'format-spec "format-spec")
(autoload 'format-spec-make "format-spec")
+ (autoload 'open-tls-stream "tls")
;; Avoid use gnus-point-at-eol so we're independent of Gnus. These
;; days we have point-at-eol anyhow.
(if (fboundp 'point-at-eol)
(defvar imap-fetch-data-hook nil
"Hooks called after receiving each FETCH response.")
-(defvar imap-streams '(gssapi kerberos4 starttls ssl network shell)
+(defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell)
"Priority of streams to consider when opening connection to server.")
(defvar imap-stream-alist
'((gssapi imap-gssapi-stream-p imap-gssapi-open)
(kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
+ (tls imap-tls-p imap-tls-open)
(ssl imap-ssl-p imap-ssl-open)
(network imap-network-p imap-network-open)
(shell imap-shell-p imap-shell-open)
(defconst imap-default-port 143)
(defconst imap-default-ssl-port 993)
+(defconst imap-default-tls-port 993)
(defconst imap-default-stream 'network)
(defconst imap-coding-system-for-read 'binary)
(defconst imap-coding-system-for-write 'binary)
(message "imap: Opening SSL connection with `%s'...failed" cmd)
nil)))
+(defun imap-tls-p (buffer)
+ nil)
+
+(defun imap-tls-open (name buffer server port)
+ (let* ((port (or port imap-default-tls-port))
+ (coding-system-for-read imap-coding-system-for-read)
+ (coding-system-for-write imap-coding-system-for-write)
+ (process (open-tls-stream name buffer server port)))
+ (when process
+ (while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-max))
+ (forward-line -1)
+ (not (imap-parse-greeting)))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (and imap-log
+ (with-current-buffer (get-buffer-create imap-log-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert-buffer-substring buffer)))
+ (when (memq (process-status process) '(open run))
+ process))))
+
(defun imap-network-p (buffer)
t)
(defvoo nnimap-server-port nil
"Port number on physical IMAP server.
-If nil, defaults to 993 for SSL connections and 143 otherwise.")
+If nil, defaults to 993 for TLS/SSL connections and 143 otherwise.")
;; Splitting variables
Change this if
-1) you want to connect with SSL. The SSL integration with IMAP is
- brain-dead so you'll have to tell it specifically.
+1) you want to connect with TLS/SSL. The TLS/SSL integration
+ with IMAP is suboptimal so you'll have to tell it
+ specifically.
2) your server is more capable than your environment -- i.e. your
server accept Kerberos login's but you haven't installed the
`imtest' program or your machine isn't configured for Kerberos.
-Possible choices: kerberos4, ssl, network")
+Possible choices: gssapi, kerberos4, starttls, tls, ssl, network, shell.
+See also `imap-streams' and `imap-stream-alist'.")
(defvoo nnimap-authenticator nil
"How nnimap authenticate itself to the server.
installed the `imtest' program or your machine isn't configured for
Kerberos.
-Possible choices: kerberos4, cram-md5, login, anonymous.")
+Possible choices: gssapi, kerberos4, digest-md5, cram-md5, login, anonymous.
+See also `imap-authenticators' and `imap-authenticator-alist'")
(defvoo nnimap-directory (nnheader-concat gnus-directory "overview/")
"Directory to keep NOV cache files for nnimap groups.
--- /dev/null
+;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
+
+;; Copyright (C) 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; Keywords: comm, tls, gnutls, ssl
+
+;; This file is part of GNU Emacs.
+
+;; 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 2, 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
+;; 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., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package implements a simple wrapper around "gnutls-cli" to
+;; make Emacs support TLS/SSL.
+;;
+;; Usage is the same as `open-network-stream', i.e.:
+;;
+;; (setq tmp (open-tls-stream "test" (current-buffer) "news.mozilla.org" 563))
+;; ...
+;; #<process test>
+;; (process-send-string tmp "mode reader\n")
+;; 200 secnews.netscape.com Netscape-Collabra/3.52 03615 NNRP ready ...
+;; nil
+;; (process-send-string tmp "quit\n")
+;; 205
+;; nil
+
+;; To use this package as a replacement for ssl.el by William M. Perry
+;; <wmperry@cs.indiana.edu>, you need to evaluate the following:
+;;
+;; (defalias 'open-ssl-stream 'open-tls-stream)
+
+;;; Code:
+
+(eval-and-compile
+ (autoload 'format-spec "format-spec")
+ (autoload 'format-spec-make "format-spec"))
+
+(defgroup tls nil
+ "Transport Layer Security (TLS) parameters."
+ :group 'comm)
+
+(defcustom tls-program '("gnutls-cli -p %p %h"
+ "gnutls-cli -p %p %h --protocols ssl3")
+ "List of strings containing commands to start TLS stream to a host.
+Each entry in the list is tried until a connection is successful.
+%s is replaced with server hostname, %p with port to connect to.
+The program should read input on stdin and write output to
+stdout. Also see `tls-success' for what the program should output
+after successful negotiation."
+ :type '(repeat string)
+ :group 'tls)
+
+(defcustom tls-process-connection-type nil
+ "*Value for `process-connection-type' to use when starting process."
+ :type 'boolean
+ :group 'tls)
+
+(defcustom tls-success "- Handshake was completed"
+ "*Regular expression indicating completed TLS handshakes.
+The default is what GNUTLS's \"gnutls-cli\" outputs."
+ :type 'regexp
+ :group 'tls)
+
+(defun open-tls-stream (name buffer host service)
+ "Open a TLS connection for a service to a host.
+Returns a subprocess-object to represent the connection.
+Input and output work as for subprocesses; `delete-process' closes it.
+Args are NAME BUFFER HOST SERVICE.
+NAME is name for process. It is modified if necessary to make it unique.
+BUFFER is the buffer (or buffer-name) to associate with the process.
+ Process output goes at end of that buffer, unless you specify
+ an output stream or filter function to handle the output.
+ BUFFER may be also nil, meaning that this process is not associated
+ with any buffer
+Third arg is name of the host to connect to, or its IP address.
+Fourth arg SERVICE is name of the service desired, or an integer
+specifying a port number to connect to."
+ (let ((cmds tls-program) cmd done)
+ (message "Opening TLS connection to `%s'..." host)
+ (while (and (not done) (setq cmd (pop cmds)))
+ (message "Opening TLS connection with `%s'..." cmd)
+ (let* ((process-connection-type tls-process-connection-type)
+ (process (start-process
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?h host
+ ?p (if (integerp service)
+ (int-to-string service)
+ service)))))
+ response)
+ (while (and process
+ (memq (process-status process) '(open run))
+ (save-excursion
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-min))
+ (not (setq done (re-search-forward tls-success nil t)))))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (message "Opening TLS connection with `%s'...%s" cmd
+ (if done "done" "failed"))
+ (if done
+ (setq done process)
+ (delete-process process))))
+ (message "Opening TLS connection to `%s'...%s"
+ host (if done "done" "failed"))
+ done))
+
+(provide 'tls)
+
+;;; tls.el ends here
projects / gnus / commitdiff