X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fstarttls.el;h=cc7192b1aea35de8c8d76578c986fa1af99d891b;hp=2cacdd28be7bd5f8d7768619e10bd0aecd810019;hb=559e4108ff97c334f5affb3519657e73dfe3dad7;hpb=9b139a13c0650a18872ebd64849560a97554afa8 diff --git a/lisp/starttls.el b/lisp/starttls.el index 2cacdd28b..cc7192b1a 100644 --- a/lisp/starttls.el +++ b/lisp/starttls.el @@ -1,29 +1,26 @@ ;;; starttls.el --- STARTTLS functions -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 1999-2015 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Author: Simon Josefsson ;; Created: 1999/11/20 -;; Keywords: TLS, SSL, OpenSSL, GNUTLS, mail, news +;; Keywords: TLS, SSL, OpenSSL, GnuTLS, mail, news ;; 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: @@ -36,15 +33,15 @@ ;; implementations both called "starttls.el". The first one is Daiki ;; Ueno's starttls.el which uses his own "starttls" command line tool, ;; and the second one is Simon Josefsson's starttls.el which uses -;; "gnutls-cli" from GNUTLS. +;; "gnutls-cli" from GnuTLS. ;; -;; If "starttls" is available, it is prefered by the code over +;; If "starttls" is available, it is preferred by the code over ;; "gnutls-cli", for backwards compatibility. Use ;; `starttls-use-gnutls' to toggle between implementations if you have -;; both tools installed. It is recommended to use GNUTLS, though, as +;; both tools installed. It is recommended to use GnuTLS, though, as ;; it performs more verification of the certificates. -;; The GNUTLS support requires GNUTLS 0.9.90 (released 2003-10-08) or +;; The GnuTLS support requires GnuTLS 0.9.90 (released 2003-10-08) or ;; later, from , or "starttls" ;; from . @@ -124,8 +121,8 @@ :group 'mail) (defcustom starttls-gnutls-program "gnutls-cli" - "Name of GNUTLS command line tool. -This program is used when GNUTLS is used, i.e. when + "Name of GnuTLS command line tool. +This program is used when GnuTLS is used, i.e. when `starttls-use-gnutls' is non-nil." :version "22.1" :type 'string @@ -139,7 +136,7 @@ i.e. when `starttls-use-gnutls' is nil." :group 'starttls) (defcustom starttls-use-gnutls (not (executable-find starttls-program)) - "*Whether to use GNUTLS instead of the `starttls' command." + "*Whether to use GnuTLS instead of the `starttls' command." :version "22.1" :type 'boolean :group 'starttls) @@ -152,8 +149,8 @@ These apply when the `starttls' command is used, i.e. when :group 'starttls) (defcustom starttls-extra-arguments nil - "Extra arguments to `starttls-program'. -These apply when GNUTLS is used, i.e. when `starttls-use-gnutls' is non-nil. + "Extra arguments to `starttls-gnutls-program'. +These apply when GnuTLS is used, i.e. when `starttls-use-gnutls' is non-nil. For example, non-TLS compliant servers may require '(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to @@ -170,8 +167,8 @@ find out which parameters are available." (defcustom starttls-connect "- Simple Client Mode:\n\n" "*Regular expression indicating successful connection. -The default is what GNUTLS's \"gnutls-cli\" outputs." - ;; GNUTLS cli.c:main() prints this string when it is starting to run +The default is what GnuTLS's \"gnutls-cli\" outputs." + ;; GnuTLS cli.c:main() prints this string when it is starting to run ;; in the application read/write phase. If the logic, or the string ;; itself, is modified, this must be updated. :version "22.1" @@ -180,8 +177,8 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." (defcustom starttls-failure "\\*\\*\\* Handshake has failed" "*Regular expression indicating failed TLS handshake. -The default is what GNUTLS's \"gnutls-cli\" outputs." - ;; GNUTLS cli.c:do_handshake() prints this string on failure. If the +The default is what GnuTLS's \"gnutls-cli\" outputs." + ;; GnuTLS cli.c:do_handshake() prints this string on failure. If the ;; logic, or the string itself, is modified, this must be updated. :version "22.1" :type 'regexp @@ -189,8 +186,8 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." (defcustom starttls-success "- Compression: " "*Regular expression indicating completed TLS handshakes. -The default is what GNUTLS's \"gnutls-cli\" outputs." - ;; GNUTLS cli.c:do_handshake() calls, on success, +The default is what GnuTLS's \"gnutls-cli\" outputs." + ;; GnuTLS cli.c:do_handshake() calls, on success, ;; common.c:print_info(), that unconditionally print this string ;; last. If that logic, or the string itself, is modified, this ;; must be updated. @@ -243,7 +240,7 @@ handshake, or nil on failure." 'process-kill-without-query))) (defun starttls-open-stream-gnutls (name buffer host port) - (message "Opening STARTTLS connection to `%s'..." host) + (message "Opening STARTTLS connection to `%s:%s'..." host port) (let* (done (old-max (with-current-buffer buffer (point-max))) (process-connection-type starttls-process-connection-type) @@ -256,8 +253,7 @@ handshake, or nil on failure." (starttls-set-process-query-on-exit-flag process nil) (while (and (processp process) (eq (process-status process) 'run) - (save-excursion - (set-buffer buffer) + (with-current-buffer buffer (goto-char old-max) (not (setq done (re-search-forward starttls-connect nil t))))) @@ -268,10 +264,11 @@ handshake, or nil on failure." (delete-region old-max done)) (delete-process process) (setq process nil)) - (message "Opening STARTTLS connection to `%s'...%s" - host (if done "done" "failed")) + (message "Opening STARTTLS connection to `%s:%s'...%s" + host port (if done "done" "failed")) process)) +;;;###autoload (defun starttls-open-stream (name buffer host port) "Open a TLS connection for a port to a host. Returns a subprocess object to represent the connection. @@ -286,9 +283,10 @@ BUFFER is the buffer (or `buffer-name') to associate with the process. Third arg is name of the host to connect to, or its IP address. Fourth arg PORT is an integer specifying a port to connect to. If `starttls-use-gnutls' is nil, this may also be a service name, but -GNUTLS requires a port number." +GnuTLS requires a port number." (if starttls-use-gnutls (starttls-open-stream-gnutls name buffer host port) + (message "Opening STARTTLS connection to `%s:%s'" host (format "%s" port)) (let* ((process-connection-type starttls-process-connection-type) (process (apply #'start-process name buffer starttls-program @@ -297,7 +295,17 @@ GNUTLS requires a port number." (starttls-set-process-query-on-exit-flag process nil) process))) +(defun starttls-available-p () + "Say whether the STARTTLS programs are available." + (and (not (memq system-type '(windows-nt ms-dos))) + (executable-find (if starttls-use-gnutls + starttls-gnutls-program + starttls-program)))) + +(defalias 'starttls-any-program-available 'starttls-available-p) +(make-obsolete 'starttls-any-program-available 'starttls-available-p + "2011-08-02") + (provide 'starttls) -;;; arch-tag: 648b3bd8-63bd-47f5-904c-7c819aea2297 ;;; starttls.el ends here