;;; 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 <ueno@unixuser.org>
;; Author: Simon Josefsson <simon@josefsson.org>
;; 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 2, 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:
;; 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 <http://www.gnu.org/software/gnutls/>, or "starttls"
;; from <ftp://ftp.opaopa.org/pub/elisp/>.
: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
: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)
: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
(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"
(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
(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.
'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)
(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)))))
(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.
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
(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
projects / gnus / blobdiff