cgit.sxemacs.org Git - gnus/blob - lisp/tls.el

   1 ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
   2
   3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Author: Simon Josefsson <simon@josefsson.org>
   7 ;; Keywords: comm, tls, gnutls, ssl
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; This package implements a simple wrapper around "gnutls-cli" to
  27 ;; make Emacs support TLS/SSL.
  28 ;;
  29 ;; Usage is the same as `open-network-stream', i.e.:
  30 ;;
  31 ;; (setq tmp (open-tls-stream "test" (current-buffer) "news.mozilla.org" 563))
  32 ;; ...
  33 ;; #<process test>
  34 ;; (process-send-string tmp "mode reader\n")
  35 ;; 200 secnews.netscape.com Netscape-Collabra/3.52 03615 NNRP ready ...
  36 ;; nil
  37 ;; (process-send-string tmp "quit\n")
  38 ;; 205
  39 ;; nil
  40
  41 ;; To use this package as a replacement for ssl.el by William M. Perry
  42 ;; <wmperry@cs.indiana.edu>, you need to evaluate the following:
  43 ;;
  44 ;; (defalias 'open-ssl-stream 'open-tls-stream)
  45
  46 ;;; Code:
  47
  48 (eval-and-compile
  49   (autoload 'format-spec "format-spec")
  50   (autoload 'format-spec-make "format-spec"))
  51
  52 (defgroup tls nil
  53   "Transport Layer Security (TLS) parameters."
  54   :group 'comm)
  55
  56 (defcustom tls-end-of-info
  57   (concat
  58    "\\("
  59    ;; `openssl s_client' regexp.  See ssl/ssl_txt.c lines 219-220.
  60    ;; According to apps/s_client.c line 1515 `---' is always the last
  61    ;; line that is printed by s_client before the real data.
  62    "^    Verify return code: .+\n---\n\\|"
  63    ;; `gnutls' regexp. See src/cli.c lines 721-.
  64    "^- Simple Client Mode:\n"
  65    "\\(\n\\|"                           ; ignore blank lines
  66    ;; According to GnuTLS v2.1.5 src/cli.c lines 640-650 and 705-715
  67    ;; in `main' the handshake will start after this message.  If the
  68    ;; handshake fails, the programs will abort.
  69    "^\\*\\*\\* Starting TLS handshake\n\\)*"
  70    "\\)")
  71   "Regexp matching end of TLS client informational messages.
  72 Client data stream begins after the last character matched by
  73 this.  The default matches `openssl s_client' (version 0.9.8c)
  74 and `gnutls-cli' (version 2.0.1) output."
  75   :version "22.2"
  76   :type 'regexp
  77   :group 'tls)
  78
  79 (defcustom tls-program '("gnutls-cli -p %p %h"
  80                          "gnutls-cli -p %p %h --protocols ssl3"
  81                          "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")
  82   "List of strings containing commands to start TLS stream to a host.
  83 Each entry in the list is tried until a connection is successful.
  84 %h is replaced with server hostname, %p with port to connect to.
  85 The program should read input on stdin and write output to
  86 stdout.
  87
  88 See `tls-checktrust' on how to check trusted root certs.
  89
  90 Also see `tls-success' for what the program should output after
  91 successful negotiation."
  92   :type
  93   '(choice
  94     (list :tag "Choose commands"
  95           :value
  96           ("gnutls-cli -p %p %h"
  97            "gnutls-cli -p %p %h --protocols ssl3"
  98            "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")
  99           (set :inline t
 100                ;; FIXME: add brief `:tag "..."' descriptions.
 101                ;; (repeat :inline t :tag "Other" (string))
 102                ;; See `tls-checktrust':
 103                (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h")
 104                (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3")
 105                (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof")
 106                ;; No trust check:
 107                (const "gnutls-cli -p %p %h")
 108                (const "gnutls-cli -p %p %h --protocols ssl3")
 109                (const "openssl s_client -connect %h:%p -no_ssl2 -ign_eof"))
 110           (repeat :inline t :tag "Other" (string)))
 111     (const :tag "Default list of commands"
 112            ("gnutls-cli -p %p %h"
 113             "gnutls-cli -p %p %h --protocols ssl3"
 114             "openssl s_client -connect %h:%p -no_ssl2 -ign_eof"))
 115     (list :tag "List of commands"
 116           (repeat :tag "Command" (string))))
 117   :version "22.1"
 118   :group 'tls)
 119
 120 (defcustom tls-process-connection-type nil
 121   "Value for `process-connection-type' to use when starting TLS process."
 122   :version "22.1"
 123   :type 'boolean
 124   :group 'tls)
 125
 126 (defcustom tls-success "- Handshake was completed\\|SSL handshake has read "
 127   "Regular expression indicating completed TLS handshakes.
 128 The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
 129 \"openssl s_client\" outputs."
 130   :version "22.1"
 131   :type 'regexp
 132   :group 'tls)
 133
 134 (defcustom tls-checktrust nil
 135   "Indicate if certificates should be checked against trusted root certs.
 136 If this is `ask', the user can decide whether to accept an
 137 untrusted certificate.  You may have to adapt `tls-program' in
 138 order to make this feature work properly, i.e., to ensure that
 139 the external program knows about the root certificates you
 140 consider trustworthy, e.g.:
 141
 142 \(setq tls-program
 143       '(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\"
 144         \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\"
 145         \"openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof\"))"
 146   :type '(choice (const :tag "Always" t)
 147                  (const :tag "Never" nil)
 148                  (const :tag "Ask" ask))
 149   :version "23.1" ;; No Gnus
 150   :group 'tls)
 151
 152 (defcustom tls-untrusted
 153   "- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)"
 154   "Regular expression indicating failure of TLS certificate verification.
 155 The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
 156 \"openssl s_client\" return in the event of unsuccessful
 157 verification."
 158   :type 'regexp
 159   :version "23.1" ;; No Gnus
 160   :group 'tls)
 161
 162 (defcustom tls-hostmismatch
 163   "# The hostname in the certificate does NOT match"
 164   "Regular expression indicating a host name mismatch in certificate.
 165 When the host name specified in the certificate doesn't match the
 166 name of the host you are connecting to, gnutls-cli issues a
 167 warning to this effect.  There is no such feature in openssl.  Set
 168 this to nil if you want to ignore host name mismatches."
 169   :type 'regexp
 170   :version "23.1" ;; No Gnus
 171   :group 'tls)
 172
 173 (defcustom tls-certtool-program (executable-find "certtool")
 174   "Name of  GnuTLS certtool.
 175 Used by `tls-certificate-information'."
 176   :version "22.1"
 177   :type 'string
 178   :group 'tls)
 179
 180 (defun tls-certificate-information (der)
 181   "Parse X.509 certificate in DER format into an assoc list."
 182   (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
 183                              (base64-encode-string der)
 184                              "\n-----END CERTIFICATE-----\n"))
 185         (exit-code 0))
 186     (with-current-buffer (get-buffer-create " *certtool*")
 187       (erase-buffer)
 188       (insert certificate)
 189       (setq exit-code (condition-case ()
 190                           (call-process-region (point-min) (point-max)
 191                                                tls-certtool-program
 192                                                t (list (current-buffer) nil) t
 193                                                "--certificate-info")
 194                         (error -1)))
 195       (if (/= exit-code 0)
 196           nil
 197         (let ((vals nil))
 198           (goto-char (point-min))
 199           (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
 200             (push (cons (match-string 1) (match-string 2)) vals))
 201           (nreverse vals))))))
 202
 203 (defun open-tls-stream (name buffer host port)
 204   "Open a TLS connection for a port to a host.
 205 Returns a subprocess-object to represent the connection.
 206 Input and output work as for subprocesses; `delete-process' closes it.
 207 Args are NAME BUFFER HOST PORT.
 208 NAME is name for process.  It is modified if necessary to make it unique.
 209 BUFFER is the buffer (or buffer name) to associate with the process.
 210  Process output goes at end of that buffer, unless you specify
 211  an output stream or filter function to handle the output.
 212  BUFFER may be also nil, meaning that this process is not associated
 213  with any buffer
 214 Third arg is name of the host to connect to, or its IP address.
 215 Fourth arg PORT is an integer specifying a port to connect to."
 216   (let ((cmds tls-program)
 217         (use-temp-buffer (null buffer))
 218         process cmd done)
 219     (if use-temp-buffer
 220         (setq buffer (generate-new-buffer " TLS")))
 221     (with-current-buffer buffer
 222       (message "Opening TLS connection to `%s'..." host)
 223       (while (and (not done) (setq cmd (pop cmds)))
 224         (message "Opening TLS connection with `%s'..." cmd)
 225         (let ((process-connection-type tls-process-connection-type)
 226               response)
 227           (setq process (start-process
 228                          name buffer shell-file-name shell-command-switch
 229                          (format-spec
 230                           cmd
 231                           (format-spec-make
 232                            ?h host
 233                            ?p (if (integerp port)
 234                                   (int-to-string port)
 235                                 port)))))
 236           (while (and process
 237                       (memq (process-status process) '(open run))
 238                       (progn
 239                         (goto-char (point-min))
 240                         (not (setq done (re-search-forward
 241                                          tls-success nil t)))))
 242             (unless (accept-process-output process 1)
 243               (sit-for 1)))
 244           (message "Opening TLS connection with `%s'...%s" cmd
 245                    (if done "done" "failed"))
 246           (if (not done)
 247               (delete-process process)
 248             ;; advance point to after all informational messages that
 249             ;; `openssl s_client' and `gnutls' print
 250             (let ((start-of-data nil))
 251               (while
 252                   (not (setq start-of-data
 253                              ;; the string matching `tls-end-of-info'
 254                              ;; might come in separate chunks from
 255                              ;; `accept-process-output', so start the
 256                              ;; search where `tls-success' ended
 257                              (save-excursion
 258                                (if (re-search-forward tls-end-of-info nil t)
 259                                    (match-end 0)))))
 260                 (accept-process-output process 1))
 261               (if start-of-data
 262                   ;; move point to start of client data
 263                   (goto-char start-of-data)))
 264             (setq done process))))
 265       (when (and done
 266                  (or
 267                   (and tls-checktrust
 268                        (save-excursion
 269                          (goto-char (point-min))
 270                          (re-search-forward tls-untrusted nil t))
 271                        (or
 272                         (and (not (eq tls-checktrust 'ask))
 273                              (message "The certificate presented by `%s' is \
 274 NOT trusted." host))
 275                         (not (yes-or-no-p
 276                               (format "The certificate presented by `%s' is \
 277 NOT trusted. Accept anyway? " host)))))
 278                   (and tls-hostmismatch
 279                        (save-excursion
 280                          (goto-char (point-min))
 281                          (re-search-forward tls-hostmismatch nil t))
 282                        (not (yes-or-no-p
 283                              (format "Host name in certificate doesn't \
 284 match `%s'. Connect anyway? " host))))))
 285         (setq done nil)
 286         (delete-process process)))
 287     (message "Opening TLS connection to `%s'...%s"
 288              host (if done "done" "failed"))
 289     (when use-temp-buffer
 290       (if done (set-process-buffer process nil))
 291       (kill-buffer buffer))
 292     done))
 293
 294 (provide 'tls)
 295
 296 ;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac
 297 ;;; tls.el ends here