From: Paul Eggert Date: Wed, 7 Dec 2016 20:43:16 +0000 (-0800) Subject: Merge from origin/emacs-25 X-Git-Tag: emacs-26.0.90~1161 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f15f6b53078ac2176f8d2c05d99d3d9b4d32986b;p=emacs.git Merge from origin/emacs-25 eeecac7 Fix minor quoting problems in doc strings --- f15f6b53078ac2176f8d2c05d99d3d9b4d32986b diff --cc lisp/net/starttls.el index 1ab7dc01645,00000000000..b9255901f97 mode 100644,000000..100644 --- a/lisp/net/starttls.el +++ b/lisp/net/starttls.el @@@ -1,304 -1,0 +1,304 @@@ +;;; starttls.el --- STARTTLS functions + +;; Copyright (C) 1999-2016 Free Software Foundation, Inc. + +;; Author: Daiki Ueno +;; Author: Simon Josefsson +;; Created: 1999/11/20 +;; 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 +;; it under the terms of the GNU General Public License as published by +;; 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 +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This module defines some utility functions for STARTTLS profiles. + +;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP" +;; by Chris Newman (1999/06) + +;; This file now contains a combination of the two previous +;; 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. +;; +;; 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 +;; it performs more verification of the certificates. + +;; The GnuTLS support requires GnuTLS 0.9.90 (released 2003-10-08) or +;; later, from , or "starttls" +;; from . + +;; Usage is similar to `open-network-stream'. For example: +;; +;; (when (setq tmp (starttls-open-stream +;; "test" (current-buffer) "yxa.extundo.com" 25)) +;; (accept-process-output tmp 15) +;; (process-send-string tmp "STARTTLS\n") +;; (accept-process-output tmp 15) +;; (message "STARTTLS output:\n%s" (starttls-negotiate tmp)) +;; (process-send-string tmp "EHLO foo\n")) + +;; An example run yields the following output: +;; +;; 220 yxa.extundo.com ESMTP Sendmail 8.12.11/8.12.11/Debian-3; Wed, 26 May 2004 19:12:29 +0200; (No UCE/UBE) logging access from: c494102a.s-bi.bostream.se(OK)-c494102a.s-bi.bostream.se [217.215.27.65] +;; 220 2.0.0 Ready to start TLS +;; 250-yxa.extundo.com Hello c494102a.s-bi.bostream.se [217.215.27.65], pleased to meet you +;; 250-ENHANCEDSTATUSCODES +;; 250-PIPELINING +;; 250-EXPN +;; 250-VERB +;; 250-8BITMIME +;; 250-SIZE +;; 250-DSN +;; 250-ETRN +;; 250-AUTH DIGEST-MD5 CRAM-MD5 PLAIN LOGIN +;; 250-DELIVERBY +;; 250 HELP +;; nil +;; +;; With the message buffer containing: +;; +;; STARTTLS output: +;; *** Starting TLS handshake +;; - Server's trusted authorities: +;; [0]: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com +;; - Certificate type: X.509 +;; - Got a certificate list of 2 certificates. +;; +;; - Certificate[0] info: +;; # The hostname in the certificate matches 'yxa.extundo.com'. +;; # valid since: Wed May 26 12:16:00 CEST 2004 +;; # expires at: Wed Jul 26 12:16:00 CEST 2023 +;; # serial number: 04 +;; # fingerprint: 7c 04 4b c1 fa 26 9b 5d 90 22 52 3c 65 3d 85 3a +;; # version: #1 +;; # public key algorithm: RSA +;; # Modulus: 1024 bits +;; # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=Mail server,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com +;; # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com +;; +;; - Certificate[1] info: +;; # valid since: Sun May 23 11:35:00 CEST 2004 +;; # expires at: Sun Jul 23 11:35:00 CEST 2023 +;; # serial number: 00 +;; # fingerprint: fc 76 d8 63 1a c9 0b 3b fa 40 fe ed 47 7a 58 ae +;; # version: #3 +;; # public key algorithm: RSA +;; # Modulus: 1024 bits +;; # Subject's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com +;; # Issuer's DN: C=SE,ST=Stockholm,L=Stockholm,O=YXA,OU=CA,CN=yxa.extundo.com,EMAIL=staff@yxa.extundo.com +;; +;; - Peer's certificate issuer is unknown +;; - Peer's certificate is NOT trusted +;; - Version: TLS 1.0 +;; - Key Exchange: RSA +;; - Cipher: ARCFOUR 128 +;; - MAC: SHA +;; - Compression: NULL + +;;; Code: + +(defgroup starttls nil + "Support for `Transport Layer Security' protocol." + :version "21.1" + :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 +`starttls-use-gnutls' is non-nil." + :version "22.1" + :type 'string + :group 'starttls) + +(defcustom starttls-program "starttls" + "The program to run in a subprocess to open an TLSv1 connection. +This program is used when the `starttls' command is used, +i.e. when `starttls-use-gnutls' is nil." + :type 'string + :group 'starttls) + +(defcustom starttls-use-gnutls (not (executable-find starttls-program)) + "Whether to use GnuTLS instead of the `starttls' command." + :version "22.1" + :type 'boolean + :group 'starttls) + +(defcustom starttls-extra-args nil + "Extra arguments to `starttls-program'. +These apply when the `starttls' command is used, i.e. when +`starttls-use-gnutls' is nil." + :type '(repeat string) + :group 'starttls) + +(defcustom starttls-extra-arguments 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 ++\(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to +find out which parameters are available." + :version "22.1" + :type '(repeat string) + :group 'starttls) + +(defcustom starttls-process-connection-type nil + "Value for `process-connection-type' to use when starting STARTTLS process." + :version "22.1" + :type 'boolean + :group 'starttls) + +(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 + ;; in the application read/write phase. If the logic, or the string + ;; itself, is modified, this must be updated. + :version "22.1" + :type 'regexp + :group 'starttls) + +(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 + ;; logic, or the string itself, is modified, this must be updated. + :version "22.1" + :type 'regexp + :group 'starttls) + +(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, + ;; common.c:print_info(), that unconditionally print this string + ;; last. If that logic, or the string itself, is modified, this + ;; must be updated. + :version "22.1" + :type 'regexp + :group 'starttls) + +(defun starttls-negotiate-gnutls (process) + "Negotiate TLS on PROCESS opened by `open-starttls-stream'. +This should typically only be done once. It typically returns a +multi-line informational message with information about the +handshake, or nil on failure." + (let (buffer info old-max done-ok done-bad) + (if (null (setq buffer (process-buffer process))) + ;; XXX How to remove/extract the TLS negotiation junk? + (signal-process (process-id process) 'SIGALRM) + (with-current-buffer buffer + (save-excursion + (setq old-max (goto-char (point-max))) + (signal-process (process-id process) 'SIGALRM) + (while (and (processp process) + (eq (process-status process) 'run) + (save-excursion + (goto-char old-max) + (not (or (setq done-ok (re-search-forward + starttls-success nil t)) + (setq done-bad (re-search-forward + starttls-failure nil t)))))) + (accept-process-output process 1 100) + (sit-for 0.1)) + (setq info (buffer-substring-no-properties old-max (point-max))) + (delete-region old-max (point-max)) + (if (or (and done-ok (not done-bad)) + ;; Prevent mitm that fake success msg after failure msg. + (and done-ok done-bad (< done-ok done-bad))) + info + (message "STARTTLS negotiation failed: %s" info) + nil)))))) + +(defun starttls-negotiate (process) + (if starttls-use-gnutls + (starttls-negotiate-gnutls process) + (signal-process (process-id process) 'SIGALRM))) + +(defun starttls-open-stream-gnutls (name buffer host port) + (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) + (process (apply #'start-process name buffer + starttls-gnutls-program "-s" host + "-p" (if (integerp port) + (int-to-string port) + port) + starttls-extra-arguments))) + (set-process-query-on-exit-flag process nil) + (while (and (processp process) + (eq (process-status process) 'run) + (with-current-buffer buffer + (goto-char old-max) + (not (setq done (re-search-forward + starttls-connect nil t))))) + (accept-process-output process 0 100) + (sit-for 0.1)) + (if done + (with-current-buffer buffer + (delete-region old-max done)) + (delete-process process) + (setq process nil)) + (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. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST PORT. +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 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." + (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 + host (format "%s" port) + starttls-extra-args))) + (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) + +;;; starttls.el ends here