From 03440feabbb3101aa039ec10ff2a41d4a38c3c20 Mon Sep 17 00:00:00 2001 From: Simon Josefsson Date: Sun, 23 Mar 2003 13:57:09 +0000 Subject: [PATCH] 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. --- lisp/ChangeLog | 16 +++++++ lisp/imap.el | 30 +++++++++++- lisp/nnimap.el | 13 +++-- lisp/tls.el | 127 +++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 180 insertions(+), 6 deletions(-) create mode 100644 lisp/tls.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 06aae03ee..b250540e5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +2003-03-23 Simon Josefsson + + * 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 * mm-url.el (mm-url-insert-file-contents): parse url only if diff --git a/lisp/imap.el b/lisp/imap.el index ae2a5fdb4..84457df02 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -152,6 +152,7 @@ (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) @@ -251,12 +252,13 @@ encoded mailboxes which doesn't translate into ISO-8859-1." (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) @@ -299,6 +301,7 @@ for doing the actual authentication.") (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) @@ -626,6 +629,31 @@ sure of changing the value of `foo'." (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) diff --git a/lisp/nnimap.el b/lisp/nnimap.el index 30756d728..bc576f481 100644 --- a/lisp/nnimap.el +++ b/lisp/nnimap.el @@ -83,7 +83,7 @@ (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 @@ -260,14 +260,16 @@ handle. 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. @@ -281,7 +283,8 @@ connect to a server that accept Kerberos login's but you haven't 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. diff --git a/lisp/tls.el b/lisp/tls.el new file mode 100644 index 000000000..70270773a --- /dev/null +++ b/lisp/tls.el @@ -0,0 +1,127 @@ +;;; tls.el --- TLS/SSL support via wrapper around GnuTLS + +;; Copyright (C) 2003 Free Software Foundation, Inc. + +;; Author: Simon Josefsson +;; 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-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 +;; , 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 -- 2.25.1