X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Ftls.el;h=0ab4293f0d6acd1d0dfafda0cb6387643b6df453;hb=024b75d7201ca46a00c823e111c36aa0535bec2d;hp=213740b8e385f46a354843357aa3462069f6fd65;hpb=a23997f6b53ac5a7a9958246c840959e28fde13e;p=gnus diff --git a/lisp/tls.el b/lisp/tls.el index 213740b8e..0ab4293f0 100644 --- a/lisp/tls.el +++ b/lisp/tls.el @@ -1,27 +1,25 @@ ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS -;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 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 +;; 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 . ;;; Commentary: @@ -47,17 +45,39 @@ ;;; Code: -(eval-and-compile - (autoload 'format-spec "format-spec") - (autoload 'format-spec-make "format-spec")) +(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" - "openssl s_client -connect %h:%p -no_ssl2") +(defcustom tls-end-of-info + (concat + "\\(" + ;; `openssl s_client' regexp. See ssl/ssl_txt.c lines 219-220. + ;; According to apps/s_client.c line 1515 `---' is always the last + ;; line that is printed by s_client before the real data. + "^ Verify return code: .+\n---\n\\|" + ;; `gnutls' regexp. See src/cli.c lines 721-. + "^- Simple Client Mode:\n" + "\\(\n\\|" ; ignore blank lines + ;; According to GnuTLS v2.1.5 src/cli.c lines 640-650 and 705-715 + ;; in `main' the handshake will start after this message. If the + ;; handshake fails, the programs will abort. + "^\\*\\*\\* Starting TLS handshake\n\\)*" + "\\)") + "Regexp matching end of TLS client informational messages. +Client data stream begins after the last character matched by +this. The default matches `openssl s_client' (version 0.9.8c) +and `gnutls-cli' (version 2.0.1) output." + :version "22.2" + :type 'regexp + :group 'tls) + +(defcustom tls-program '("gnutls-cli --insecure -p %p %h" + "gnutls-cli --insecure -p %p %h --protocols ssl3" + "openssl s_client -connect %h:%p -no_ssl2 -ign_eof") "List of strings containing commands to start TLS stream to a host. Each entry in the list is tried until a connection is successful. %h is replaced with server hostname, %p with port to connect to. @@ -74,23 +94,23 @@ successful negotiation." :value ("gnutls-cli -p %p %h" "gnutls-cli -p %p %h --protocols ssl3" - "openssl s_client -connect %h:%p -no_ssl2") + "openssl s_client -connect %h:%p -no_ssl2 -ign_eof") (set :inline t ;; FIXME: add brief `:tag "..."' descriptions. ;; (repeat :inline t :tag "Other" (string)) ;; See `tls-checktrust': (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h") (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3") - (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2") + (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof") ;; No trust check: (const "gnutls-cli -p %p %h") (const "gnutls-cli -p %p %h --protocols ssl3") - (const "openssl s_client -connect %h:%p -no_ssl2")) + (const "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) (repeat :inline t :tag "Other" (string))) (const :tag "Default list of commands" ("gnutls-cli -p %p %h" "gnutls-cli -p %p %h --protocols ssl3" - "openssl s_client -connect %h:%p -no_ssl2")) + "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) (list :tag "List of commands" (repeat :tag "Command" (string)))) :version "22.1" @@ -121,11 +141,11 @@ consider trustworthy, e.g.: \(setq tls-program '(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\" \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\" - \"openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2\"))" + \"openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof\"))" :type '(choice (const :tag "Always" t) (const :tag "Never" nil) (const :tag "Ask" ask)) - :version "23.0" ;; No Gnus + :version "23.1" ;; No Gnus :group 'tls) (defcustom tls-untrusted @@ -135,7 +155,7 @@ The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's \"openssl s_client\" return in the event of unsuccessful verification." :type 'regexp - :version "23.0" ;; No Gnus + :version "23.1" ;; No Gnus :group 'tls) (defcustom tls-hostmismatch @@ -146,7 +166,7 @@ name of the host you are connecting to, gnutls-cli issues a warning to this effect. There is no such feature in openssl. Set this to nil if you want to ignore host name mismatches." :type 'regexp - :version "23.0" ;; No Gnus + :version "23.1" ;; No Gnus :group 'tls) (defcustom tls-certtool-program (executable-find "certtool") @@ -196,56 +216,83 @@ Fourth arg PORT is an integer specifying a port to connect to." (use-temp-buffer (null buffer)) process cmd done) (if use-temp-buffer - (setq buffer (generate-new-buffer " TLS"))) - (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) - response) - (setq process (start-process - name buffer shell-file-name shell-command-switch - (format-spec - cmd - (format-spec-make - ?h host - ?p (if (integerp port) - (int-to-string port) - port))))) - (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))))) - (unless (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)))) - (when done - (save-excursion - (set-buffer buffer) - (when - (or - (and tls-checktrust - (progn - (goto-char (point-min)) - (re-search-forward tls-untrusted nil t)) - (or - (and (not (eq tls-checktrust 'ask)) - (message "The certificate presented by `%s' is NOT trusted." host)) - (not (yes-or-no-p - (format "The certificate presented by `%s' is NOT trusted. Accept anyway? " host))))) - (and tls-hostmismatch - (progn - (goto-char (point-min)) - (re-search-forward tls-hostmismatch nil t)) - (not (yes-or-no-p - (format "Host name in certificate doesn't match `%s'. Connect anyway? " host))))) - (setq done nil) - (delete-process process)))) + (setq buffer (generate-new-buffer " TLS")) + ;; BUFFER is a string but does not exist as a buffer object. + (unless (and (get-buffer buffer) + (buffer-name (get-buffer buffer))) + (generate-new-buffer buffer))) + (with-current-buffer buffer + (message "Opening TLS connection to `%s'..." host) + (while (and (not done) (setq cmd (pop cmds))) + (let ((process-connection-type tls-process-connection-type) + (formatted-cmd + (format-spec + cmd + (format-spec-make + ?h host + ?p (if (integerp port) + (int-to-string port) + port)))) + response) + (message "Opening TLS connection with `%s'..." formatted-cmd) + (setq process (start-process + name buffer shell-file-name shell-command-switch + formatted-cmd)) + (funcall (if (fboundp 'set-process-query-on-exit-flag) + 'set-process-query-on-exit-flag + 'process-kill-without-query) + process nil) + (while (and process + (memq (process-status process) '(open run)) + (progn + (goto-char (point-min)) + (not (setq done (re-search-forward + tls-success nil t))))) + (unless (accept-process-output process 1) + (sit-for 1))) + (message "Opening TLS connection with `%s'...%s" formatted-cmd + (if done "done" "failed")) + (if (not done) + (delete-process process) + ;; advance point to after all informational messages that + ;; `openssl s_client' and `gnutls' print + (let ((start-of-data nil)) + (while + (not (setq start-of-data + ;; the string matching `tls-end-of-info' + ;; might come in separate chunks from + ;; `accept-process-output', so start the + ;; search where `tls-success' ended + (save-excursion + (if (re-search-forward tls-end-of-info nil t) + (match-end 0))))) + (accept-process-output process 1)) + (if start-of-data + ;; move point to start of client data + (goto-char start-of-data))) + (setq done process)))) + (when (and done + (or + (and tls-checktrust + (save-excursion + (goto-char (point-min)) + (re-search-forward tls-untrusted nil t)) + (or + (and (not (eq tls-checktrust 'ask)) + (message "The certificate presented by `%s' is \ +NOT trusted." host)) + (not (yes-or-no-p + (format "The certificate presented by `%s' is \ +NOT trusted. Accept anyway? " host))))) + (and tls-hostmismatch + (save-excursion + (goto-char (point-min)) + (re-search-forward tls-hostmismatch nil t)) + (not (yes-or-no-p + (format "Host name in certificate doesn't \ +match `%s'. Connect anyway? " host)))))) + (setq done nil) + (delete-process process))) (message "Opening TLS connection to `%s'...%s" host (if done "done" "failed")) (when use-temp-buffer @@ -255,5 +302,4 @@ Fourth arg PORT is an integer specifying a port to connect to." (provide 'tls) -;;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac ;;; tls.el ends here