* lisp/obsolete/tls.el: Moved from lisp/net/tls.el.
* lisp/gnus/nnimap.el:
* lisp/url/url-http.el: Don't require tls, since it's obsolete.
* lisp/net/network-stream.el: Only require tls if we actually try to
use it (i.e., when (gnutls-available-p) returns nil). Declare some
functions to fix compilation warnings.
* lisp/obsolete/starttls.el: Moved from lisp/net/starttls.el.
* lisp/net/sieve-manage.el:
* lisp/net/network-stream.el: Don't require `starttls' at the
top-level, declare the variables and functions used instead.
(network-stream-open-starttls): Only require `starttls' if
needed (i.e., gnutls-available-p fails).
* etc/NEWS: Announce obsoletion.
** The options.el library has been removed.
It was obsolete since Emacs 22.1, replaced by customize.
+** The tls.el and starttls.el libraries are now marked obsolete.
+Use of built-in libgnutls based functionality (described in the Emacs
+GnuTLS manual) is recommended instead.
+
\f
** Message
(require 'nnoo)
(require 'netrc)
(require 'utf7)
-(require 'tls)
(require 'parse-time)
(require 'nnmail)
;;; Code:
-(require 'tls)
-(require 'starttls)
(require 'auth-source)
(require 'nsm)
(require 'puny)
+(declare-function starttls-available-p "starttls" ())
+(declare-function starttls-negotiate "starttls" (process))
+
(autoload 'gnutls-negotiate "gnutls")
(autoload 'open-gnutls-stream "gnutls")
+(defvar starttls-extra-arguments)
+(defvar starttls-extra-args)
+(defvar starttls-use-gnutls)
+(defvar starttls-gnutls-program)
+(defvar starttls-program)
;;;###autoload
(defun open-network-stream (name buffer host service &rest parameters)
(or (gnutls-available-p)
(and (or require-tls
(plist-get parameters :use-starttls-if-possible))
- (starttls-available-p))))
+ (require 'starttls)
+ (starttls-available-p))))
(not (eq (plist-get parameters :type) 'plain)))
;; If using external STARTTLS, drop this connection and start
;; anew with `starttls-open-stream'.
;; See `starttls-available-p'. If this predicate
;; changes to allow running under Windows, the error
;; message below should be amended.
- (if (memq system-type '(windows-nt ms-dos))
+ (if (or (memq system-type '(windows-nt ms-dos))
+ (not (featurep 'starttls)))
(concat "Emacs does not support TLS")
(concat "Emacs does not support TLS, and no external `"
(if starttls-use-gnutls
(unless (= start (point))
(buffer-substring start (point)))))))
+(declare-function open-tls-stream "tls" (name buffer host port))
+
(defun network-stream-open-tls (name buffer host service parameters)
(with-current-buffer buffer
(let* ((start (point-max))
(if (gnutls-available-p)
(open-gnutls-stream name buffer host service
(plist-get parameters :nowait))
+ (require 'tls)
(open-tls-stream name buffer host service)))
(eoc (plist-get parameters :end-of-command)))
(if (plist-get parameters :nowait)
(network-stream-command stream capability-command eo-capa)
'tls)))))))
+(declare-function format-spec "format-spec" (format spec))
+(declare-function format-spec-make "format-spec" (&rest pairs))
+
(defun network-stream-open-shell (name buffer host service parameters)
(require 'format-spec)
(let* ((capability-command (plist-get parameters :capability-command))
(eval-when-compile (require 'cl-lib))
(require 'sasl)
-(require 'starttls)
(autoload 'sasl-find-mechanism "sasl")
(autoload 'auth-source-search "auth-source")
+++ /dev/null
-;;; starttls.el --- STARTTLS functions
-
-;; Copyright (C) 1999-2018 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
-
-;; 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 <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This module defines some utility functions for STARTTLS profiles.
-
-;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP"
-;; by Chris Newman <chris.newman@innosoft.com> (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 <https://www.gnu.org/software/gnutls/>, or "starttls"
-;; from <ftp://ftp.opaopa.org/pub/elisp/>.
-
-;; 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
-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
- a 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
+++ /dev/null
-;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
-
-;; Copyright (C) 1996-1999, 2002-2018 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <simon@josefsson.org>
-;; 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 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 <https://www.gnu.org/licenses/>.
-
-;;; 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 test>
-;; (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
-;; <wmperry@cs.indiana.edu>, you need to evaluate the following:
-;;
-;; (defalias 'open-ssl-stream 'open-tls-stream)
-
-;;; Code:
-
-(require 'gnutls)
-
-(autoload 'format-spec "format-spec")
-(autoload 'format-spec-make "format-spec")
-
-(defgroup tls nil
- "Transport Layer Security (TLS) parameters."
- :group 'comm)
-
-(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 this matches.
-The default matches the output of \"gnutls-cli\" (version 2.0.1)."
- :version "22.2"
- :type 'regexp
- :group 'tls)
-
-(defcustom tls-program
- '("gnutls-cli --x509cafile %t -p %p %h"
- "gnutls-cli --x509cafile %t -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.
-%h is replaced with the server hostname, %p with the port to
-connect to, and %t with a file name containing trusted certificates.
-The program should read input on stdin and write output to stdout.
-
-See `tls-checktrust' on how to check trusted root certs.
-
-Also see `tls-success' for what the program should output after
-successful negotiation."
- :type
- '(choice
- (const :tag "Default list of commands"
- ("gnutls-cli --x509cafile %t -p %p %h"
- "gnutls-cli --x509cafile %t -p %p %h --protocols ssl3"))
- (list :tag "Choose commands"
- :value
- ("gnutls-cli --x509cafile %t -p %p %h"
- "gnutls-cli --x509cafile %t -p %p %h --protocols ssl3")
- (set :inline t
- ;; FIXME: add brief `:tag "..."' descriptions.
- ;; (repeat :inline t :tag "Other" (string))
- ;; No trust check:
- (const "gnutls-cli --insecure -p %p %h")
- (const "gnutls-cli --insecure -p %p %h --protocols ssl3"))
- (repeat :inline t :tag "Other" (string)))
- (list :tag "List of commands"
- (repeat :tag "Command" (string))))
- :version "26.1" ; remove s_client
- :group 'tls)
-
-(defcustom tls-process-connection-type nil
- "Value for `process-connection-type' to use when starting TLS process."
- :version "22.1"
- :type 'boolean
- :group 'tls)
-
-(defcustom tls-success "- Handshake was completed\\|SSL handshake has read "
- "Regular expression indicating completed TLS handshakes.
-The default is what GnuTLS's \"gnutls-cli\" outputs."
-;; or OpenSSL's \"openssl s_client\"
- :version "22.1"
- :type 'regexp
- :group 'tls)
-
-(defcustom tls-checktrust nil
- "Indicate if certificates should be checked against trusted root certs.
-If this is `ask', the user can decide whether to accept an
-untrusted certificate. You may have to adapt `tls-program' in
-order to make this feature work properly, i.e., to ensure that
-the external program knows about the root certificates you
-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\"))"
- :type '(choice (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "Ask" ask))
- :version "23.1" ;; No Gnus
- :group 'tls)
-
-(defcustom tls-untrusted
- "- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)"
- "Regular expression indicating failure of TLS certificate verification.
-The default is what GnuTLS's \"gnutls-cli\" returns in the event of
-unsuccessful verification."
-;; or OpenSSL's \"openssl s_client\"
- :type 'regexp
- :version "23.1" ;; No Gnus
- :group 'tls)
-
-(defcustom tls-hostmismatch
- "# The hostname in the certificate does NOT match"
- "Regular expression indicating a host name mismatch in certificate.
-When the host name specified in the certificate doesn't match the
-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.1" ;; No Gnus
- :group 'tls)
-
-(defcustom tls-certtool-program "certtool"
- "Name of GnuTLS certtool.
-Used by `tls-certificate-information'."
- :version "22.1"
- :type 'string
- :group 'tls)
-
-(defalias 'tls-format-message
- (if (fboundp 'format-message) 'format-message
- ;; for Emacs < 25, and XEmacs, don't worry about quote translation.
- 'format))
-
-(defun tls-certificate-information (der)
- "Parse X.509 certificate in DER format into an assoc list."
- (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
- (base64-encode-string der)
- "\n-----END CERTIFICATE-----\n"))
- (exit-code 0))
- (with-current-buffer (get-buffer-create " *certtool*")
- (erase-buffer)
- (insert certificate)
- (setq exit-code (condition-case ()
- (call-process-region (point-min) (point-max)
- tls-certtool-program
- t (list (current-buffer) nil) t
- "--certificate-info")
- (error -1)))
- (if (/= exit-code 0)
- nil
- (let ((vals nil))
- (goto-char (point-min))
- (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
- (push (cons (match-string 1) (match-string 2)) vals))
- (nreverse vals))))))
-
-(defun open-tls-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
- a 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."
- (let ((cmds tls-program)
- (use-temp-buffer (null buffer))
- process cmd done)
- (if use-temp-buffer
- (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
- ?t (car (gnutls-trustfiles))
- ?h host
- ?p (if (integerp port)
- (int-to-string port)
- port)))))
- (message "Opening TLS connection with `%s'..." formatted-cmd)
- (setq process (start-process
- name buffer shell-file-name shell-command-switch
- formatted-cmd))
- (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
- (tls-format-message "\
-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))
- ;; Delete all the informational messages that could confuse
- ;; future uses of `buffer'.
- (delete-region (point-min) (point)))
- (message "Opening TLS connection to `%s'...%s"
- host (if done "done" "failed"))
- (when use-temp-buffer
- (if done (set-process-buffer process nil))
- (kill-buffer buffer))
- done))
-
-(provide 'tls)
-
-;;; tls.el ends here
--- /dev/null
+;;; starttls.el --- STARTTLS functions
+
+;; Copyright (C) 1999-2018 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
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This module defines some utility functions for STARTTLS profiles.
+
+;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP"
+;; by Chris Newman <chris.newman@innosoft.com> (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 <https://www.gnu.org/software/gnutls/>, or "starttls"
+;; from <ftp://ftp.opaopa.org/pub/elisp/>.
+
+;; 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
+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
+ a 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
--- /dev/null
+;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
+
+;; Copyright (C) 1996-1999, 2002-2018 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson <simon@josefsson.org>
+;; 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 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 <https://www.gnu.org/licenses/>.
+
+;;; 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 test>
+;; (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
+;; <wmperry@cs.indiana.edu>, you need to evaluate the following:
+;;
+;; (defalias 'open-ssl-stream 'open-tls-stream)
+
+;;; Code:
+
+(require 'gnutls)
+
+(autoload 'format-spec "format-spec")
+(autoload 'format-spec-make "format-spec")
+
+(defgroup tls nil
+ "Transport Layer Security (TLS) parameters."
+ :group 'comm)
+
+(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 this matches.
+The default matches the output of \"gnutls-cli\" (version 2.0.1)."
+ :version "22.2"
+ :type 'regexp
+ :group 'tls)
+
+(defcustom tls-program
+ '("gnutls-cli --x509cafile %t -p %p %h"
+ "gnutls-cli --x509cafile %t -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.
+%h is replaced with the server hostname, %p with the port to
+connect to, and %t with a file name containing trusted certificates.
+The program should read input on stdin and write output to stdout.
+
+See `tls-checktrust' on how to check trusted root certs.
+
+Also see `tls-success' for what the program should output after
+successful negotiation."
+ :type
+ '(choice
+ (const :tag "Default list of commands"
+ ("gnutls-cli --x509cafile %t -p %p %h"
+ "gnutls-cli --x509cafile %t -p %p %h --protocols ssl3"))
+ (list :tag "Choose commands"
+ :value
+ ("gnutls-cli --x509cafile %t -p %p %h"
+ "gnutls-cli --x509cafile %t -p %p %h --protocols ssl3")
+ (set :inline t
+ ;; FIXME: add brief `:tag "..."' descriptions.
+ ;; (repeat :inline t :tag "Other" (string))
+ ;; No trust check:
+ (const "gnutls-cli --insecure -p %p %h")
+ (const "gnutls-cli --insecure -p %p %h --protocols ssl3"))
+ (repeat :inline t :tag "Other" (string)))
+ (list :tag "List of commands"
+ (repeat :tag "Command" (string))))
+ :version "26.1" ; remove s_client
+ :group 'tls)
+
+(defcustom tls-process-connection-type nil
+ "Value for `process-connection-type' to use when starting TLS process."
+ :version "22.1"
+ :type 'boolean
+ :group 'tls)
+
+(defcustom tls-success "- Handshake was completed\\|SSL handshake has read "
+ "Regular expression indicating completed TLS handshakes.
+The default is what GnuTLS's \"gnutls-cli\" outputs."
+;; or OpenSSL's \"openssl s_client\"
+ :version "22.1"
+ :type 'regexp
+ :group 'tls)
+
+(defcustom tls-checktrust nil
+ "Indicate if certificates should be checked against trusted root certs.
+If this is `ask', the user can decide whether to accept an
+untrusted certificate. You may have to adapt `tls-program' in
+order to make this feature work properly, i.e., to ensure that
+the external program knows about the root certificates you
+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\"))"
+ :type '(choice (const :tag "Always" t)
+ (const :tag "Never" nil)
+ (const :tag "Ask" ask))
+ :version "23.1" ;; No Gnus
+ :group 'tls)
+
+(defcustom tls-untrusted
+ "- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)"
+ "Regular expression indicating failure of TLS certificate verification.
+The default is what GnuTLS's \"gnutls-cli\" returns in the event of
+unsuccessful verification."
+;; or OpenSSL's \"openssl s_client\"
+ :type 'regexp
+ :version "23.1" ;; No Gnus
+ :group 'tls)
+
+(defcustom tls-hostmismatch
+ "# The hostname in the certificate does NOT match"
+ "Regular expression indicating a host name mismatch in certificate.
+When the host name specified in the certificate doesn't match the
+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.1" ;; No Gnus
+ :group 'tls)
+
+(defcustom tls-certtool-program "certtool"
+ "Name of GnuTLS certtool.
+Used by `tls-certificate-information'."
+ :version "22.1"
+ :type 'string
+ :group 'tls)
+
+(defalias 'tls-format-message
+ (if (fboundp 'format-message) 'format-message
+ ;; for Emacs < 25, and XEmacs, don't worry about quote translation.
+ 'format))
+
+(defun tls-certificate-information (der)
+ "Parse X.509 certificate in DER format into an assoc list."
+ (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
+ (base64-encode-string der)
+ "\n-----END CERTIFICATE-----\n"))
+ (exit-code 0))
+ (with-current-buffer (get-buffer-create " *certtool*")
+ (erase-buffer)
+ (insert certificate)
+ (setq exit-code (condition-case ()
+ (call-process-region (point-min) (point-max)
+ tls-certtool-program
+ t (list (current-buffer) nil) t
+ "--certificate-info")
+ (error -1)))
+ (if (/= exit-code 0)
+ nil
+ (let ((vals nil))
+ (goto-char (point-min))
+ (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
+ (push (cons (match-string 1) (match-string 2)) vals))
+ (nreverse vals))))))
+
+(defun open-tls-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
+ a 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."
+ (let ((cmds tls-program)
+ (use-temp-buffer (null buffer))
+ process cmd done)
+ (if use-temp-buffer
+ (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
+ ?t (car (gnutls-trustfiles))
+ ?h host
+ ?p (if (integerp port)
+ (int-to-string port)
+ port)))))
+ (message "Opening TLS connection with `%s'..." formatted-cmd)
+ (setq process (start-process
+ name buffer shell-file-name shell-command-switch
+ formatted-cmd))
+ (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
+ (tls-format-message "\
+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))
+ ;; Delete all the informational messages that could confuse
+ ;; future uses of `buffer'.
+ (delete-region (point-min) (point)))
+ (message "Opening TLS connection to `%s'...%s"
+ host (if done "done" "failed"))
+ (when use-temp-buffer
+ (if done (set-process-buffer process nil))
+ (kill-buffer buffer))
+ done))
+
+(provide 'tls)
+
+;;; tls.el ends here
;; HTTPS. This used to be in url-https.el, but that file collides
;; with url-http.el on systems with 8-character file names.
-(require 'tls)
(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
projects / emacs.git / commitdiff