lisp/net/gnutls.el

   1 ;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
   2
   3 ;; Copyright (C) 2010-2018 Free Software Foundation, Inc.
   4
   5 ;; Author: Ted Zlatanov <tzz@lifelogs.com>
   6 ;; Keywords: comm, tls, ssl, encryption
   7 ;; Originally-By: Simon Josefsson (See http://josefsson.org/emacs-security/)
   8 ;; Thanks-To: Lars Magne Ingebrigtsen <larsi@gnus.org>
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; This package provides language bindings for the GnuTLS library
  28 ;; using the corresponding core functions in gnutls.c.  It should NOT
  29 ;; be used directly, only through open-network-stream.
  30
  31 ;; Simple test:
  32 ;;
  33 ;; (open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https")
  34 ;; (open-gnutls-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")
  35
  36 ;;; Code:
  37
  38 (require 'cl-lib)
  39
  40 (defgroup gnutls nil
  41   "Emacs interface to the GnuTLS library."
  42   :version "24.1"
  43   :prefix "gnutls-"
  44   :group 'comm)
  45
  46 (defcustom gnutls-algorithm-priority nil
  47   "If non-nil, this should be a TLS priority string.
  48 For instance, if you want to skip the \"dhe-rsa\" algorithm,
  49 set this variable to \"normal:-dhe-rsa\"."
  50   :group 'gnutls
  51   :type '(choice (const nil)
  52                  string))
  53
  54 (defcustom gnutls-verify-error nil
  55   "If non-nil, this should be t or a list of checks per hostname regex.
  56 If nil, the default, failures in certificate verification will be
  57 logged (subject to `gnutls-log-level'), but the connection will be
  58 allowed to proceed.
  59 If the value is a list, it should have the form
  60
  61    ((HOST-REGEX FLAGS...) (HOST-REGEX FLAGS...) ...)
  62
  63 where each HOST-REGEX is a regular expression to be matched
  64 against the hostname, and FLAGS is either t or a list of
  65 one or more verification flags.  The supported flags and the
  66 corresponding conditions to be tested are:
  67
  68   :trustfiles -- certificate must be issued by a trusted authority.
  69   :hostname   -- hostname must match presented certificate's host name.
  70   t           -- all of the above conditions are tested.
  71
  72 If the condition test fails, an error will be signaled.
  73
  74 If the value of this variable is t, every connection will be subjected
  75 to all of the tests described above."
  76   :group 'gnutls
  77   :version "24.4"
  78   :type '(choice
  79           (const t)
  80           (repeat :tag "List of hostname regexps with flags for each"
  81            (list
  82             (choice :tag "Hostname"
  83                     (const ".*" :tag "Any hostname")
  84                     regexp)
  85             (set (const :trustfiles)
  86                  (const :hostname))))))
  87
  88 (defcustom gnutls-trustfiles
  89   '(
  90     "/etc/ssl/certs/ca-certificates.crt"     ; Debian, Ubuntu, Gentoo and Arch Linux
  91     "/etc/pki/tls/certs/ca-bundle.crt"       ; Fedora and RHEL
  92     "/etc/ssl/ca-bundle.pem"                 ; Suse
  93     "/usr/ssl/certs/ca-bundle.crt"           ; Cygwin
  94     "/usr/local/share/certs/ca-root-nss.crt" ; FreeBSD
  95     "/etc/ssl/cert.pem"                      ; macOS
  96     )
  97   "List of CA bundle location filenames or a function returning said list.
  98 The files may be in PEM or DER format, as per the GnuTLS documentation.
  99 The files may not exist, in which case they will be ignored."
 100   :group 'gnutls
 101   :type '(choice (function :tag "Function to produce list of bundle filenames")
 102                  (repeat (file :tag "Bundle filename"))))
 103
 104 ;;;###autoload
 105 (defcustom gnutls-min-prime-bits 256
 106   ;; Several mail servers send fewer bits than the GnuTLS default.
 107   ;; Currently, 256 appears to be a reasonable choice (Bug#11267).
 108   "Minimum number of prime bits accepted by GnuTLS for key exchange.
 109 During a Diffie-Hellman handshake, if the server sends a prime
 110 number with fewer than this number of bits, the handshake is
 111 rejected.  \(The smaller the prime number, the less secure the
 112 key exchange is against man-in-the-middle attacks.)
 113
 114 A value of nil says to use the default GnuTLS value."
 115   :type '(choice (const :tag "Use default value" nil)
 116                  (integer :tag "Number of bits" 512))
 117   :group 'gnutls)
 118
 119 (defun open-gnutls-stream (name buffer host service &optional nowait)
 120   "Open a SSL/TLS connection for a service to a host.
 121 Returns a subprocess-object to represent the connection.
 122 Input and output work as for subprocesses; `delete-process' closes it.
 123 Args are NAME BUFFER HOST SERVICE.
 124 NAME is name for process.  It is modified if necessary to make it unique.
 125 BUFFER is the buffer (or `buffer-name') to associate with the process.
 126  Process output goes at end of that buffer, unless you specify
 127  a filter function to handle the output.
 128  BUFFER may be also nil, meaning that this process is not associated
 129  with any buffer
 130 Third arg is name of the host to connect to, or its IP address.
 131 Fourth arg SERVICE is name of the service desired, or an integer
 132 specifying a port number to connect to.
 133 Fifth arg NOWAIT (which is optional) means that the socket should
 134 be opened asynchronously.  The connection process will be
 135 returned to the caller before TLS negotiation has happened.
 136
 137 Usage example:
 138
 139   (with-temp-buffer
 140     (open-gnutls-stream \"tls\"
 141                         (current-buffer)
 142                         \"your server goes here\"
 143                         \"imaps\"))
 144
 145 This is a very simple wrapper around `gnutls-negotiate'.  See its
 146 documentation for the specific parameters you can use to open a
 147 GnuTLS connection, including specifying the credential type,
 148 trust and key files, and priority string."
 149   (let ((process (open-network-stream
 150                   name buffer host service
 151                   :nowait nowait
 152                   :tls-parameters
 153                   (and nowait
 154                        (cons 'gnutls-x509pki
 155                              (gnutls-boot-parameters
 156                               :type 'gnutls-x509pki
 157                               :hostname host))))))
 158     (if nowait
 159         process
 160       (gnutls-negotiate :process process
 161                         :type 'gnutls-x509pki
 162                         :hostname host))))
 163
 164 (define-error 'gnutls-error "GnuTLS error")
 165
 166 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 167 (declare-function gnutls-errorp "gnutls.c" (error))
 168 (defvar gnutls-log-level)               ; gnutls.c
 169
 170 (cl-defun gnutls-negotiate
 171     (&rest spec
 172            &key process type hostname priority-string
 173            trustfiles crlfiles keylist min-prime-bits
 174            verify-flags verify-error verify-hostname-error
 175            &allow-other-keys)
 176   "Negotiate a SSL/TLS connection.  Returns proc.  Signals gnutls-error.
 177
 178 Note that arguments are passed CL style, :type TYPE instead of just TYPE.
 179
 180 PROCESS is a process returned by `open-network-stream'.
 181 For the meaning of the rest of the parameters, see `gnutls-boot-parameters'."
 182   (let* ((type (or type 'gnutls-x509pki))
 183          ;; The gnutls library doesn't understand files delivered via
 184          ;; the special handlers, so ignore all files found via those.
 185          (file-name-handler-alist nil)
 186          (params (gnutls-boot-parameters
 187                   :type type
 188                   :hostname hostname
 189                   :priority-string priority-string
 190                   :trustfiles trustfiles
 191                   :crlfiles crlfiles
 192                   :keylist keylist
 193                   :min-prime-bits min-prime-bits
 194                   :verify-flags verify-flags
 195                   :verify-error verify-error
 196                   :verify-hostname-error verify-hostname-error))
 197          ret)
 198     (gnutls-message-maybe
 199      (setq ret (gnutls-boot process type
 200                             (append (list :complete-negotiation t)
 201                                     params)))
 202      "boot: %s" params)
 203
 204     (when (gnutls-errorp ret)
 205       ;; This is an error from the underlying C code.
 206       (signal 'gnutls-error (list process ret)))
 207
 208     process))
 209
 210 (cl-defun gnutls-boot-parameters
 211     (&rest spec
 212            &key type hostname priority-string
 213            trustfiles crlfiles keylist min-prime-bits
 214            verify-flags verify-error verify-hostname-error
 215            &allow-other-keys)
 216   "Return a keyword list of parameters suitable for passing to `gnutls-boot'.
 217
 218 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 219 HOSTNAME is the remote hostname.  It must be a valid string.
 220 PRIORITY-STRING is as per the GnuTLS docs, default is based on \"NORMAL\".
 221 TRUSTFILES is a list of CA bundles.  It defaults to `gnutls-trustfiles'.
 222 CRLFILES is a list of CRL files.
 223 KEYLIST is an alist of (client key file, client cert file) pairs.
 224 MIN-PRIME-BITS is the minimum acceptable size of Diffie-Hellman keys
 225 \(see `gnutls-min-prime-bits' for more information).  Use nil for the
 226 default.
 227
 228 VERIFY-HOSTNAME-ERROR is a backwards compatibility option for
 229 putting `:hostname' in VERIFY-ERROR.
 230
 231 When VERIFY-ERROR is t or a list containing `:trustfiles', an
 232 error will be raised when the peer certificate verification fails
 233 as per GnuTLS' gnutls_certificate_verify_peers2.  Otherwise, only
 234 warnings will be shown about the verification failure.
 235
 236 When VERIFY-ERROR is t or a list containing `:hostname', an error
 237 will be raised when the hostname does not match the presented
 238 certificate's host name.  The exact verification algorithm is a
 239 basic implementation of the matching described in
 240 RFC2818 (HTTPS), which takes into account wildcards, and the
 241 DNSName/IPAddress subject alternative name PKIX extension.  See
 242 GnuTLS' gnutls_x509_crt_check_hostname for details.  Otherwise,
 243 only a warning will be issued.
 244
 245 Note that the list in `gnutls-verify-error', matched against the
 246 HOSTNAME, is the default VERIFY-ERROR.
 247
 248 VERIFY-FLAGS is a numeric OR of verification flags only for
 249 `gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
 250 here's a recent version of the list.
 251
 252     GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
 253     GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
 254     GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
 255     GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
 256     GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
 257     GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
 258     GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
 259     GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
 260     GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
 261
 262 It must be omitted, a number, or nil; if omitted or nil it
 263 defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
 264   (let* ((trustfiles (or trustfiles (gnutls-trustfiles)))
 265          (maybe-dumbfw (if (memq 'ClientHello\ Padding (gnutls-available-p))
 266                            ":%DUMBFW"
 267                          ""))
 268          (priority-string (or priority-string
 269                               (cond
 270                                ((eq type 'gnutls-anon)
 271                                 (concat "NORMAL:+ANON-DH:!ARCFOUR-128"
 272                                         maybe-dumbfw))
 273                                ((eq type 'gnutls-x509pki)
 274                                 (if gnutls-algorithm-priority
 275                                     (upcase gnutls-algorithm-priority)
 276                                   (concat "NORMAL" maybe-dumbfw))))))
 277          (verify-error (or verify-error
 278                            ;; this uses the value of `gnutls-verify-error'
 279                            (cond
 280                             ;; if t, pass it on
 281                             ((eq gnutls-verify-error t)
 282                              t)
 283                             ;; if a list, look for hostname matches
 284                             ((listp gnutls-verify-error)
 285                              (apply 'append
 286                                     (mapcar
 287                                      (lambda (check)
 288                                        (when (string-match (nth 0 check)
 289                                                            hostname)
 290                                          (nth 1 check)))
 291                                      gnutls-verify-error)))
 292                             ;; else it's nil
 293                             (t nil))))
 294          (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)))
 295
 296     (when verify-hostname-error
 297       (push :hostname verify-error))
 298
 299     `(:priority ,priority-string
 300                 :hostname ,hostname
 301                 :loglevel ,gnutls-log-level
 302                 :min-prime-bits ,min-prime-bits
 303                 :trustfiles ,trustfiles
 304                 :crlfiles ,crlfiles
 305                 :keylist ,keylist
 306                 :verify-flags ,verify-flags
 307                 :verify-error ,verify-error
 308                 :callbacks nil)))
 309
 310 (defun gnutls-trustfiles ()
 311   "Return a list of usable trustfiles."
 312   (delq nil
 313         (mapcar (lambda (f) (and f (file-exists-p f) f))
 314                 (if (functionp gnutls-trustfiles)
 315                     (funcall gnutls-trustfiles)
 316                   gnutls-trustfiles))))
 317
 318 (declare-function gnutls-error-string "gnutls.c" (error))
 319
 320 (defun gnutls-message-maybe (doit format &rest params)
 321   "When DOIT, message with the caller name followed by FORMAT on PARAMS."
 322   ;; (apply 'debug format (or params '(nil)))
 323   (when (gnutls-errorp doit)
 324     (message "%s: (err=[%s] %s) %s"
 325              "gnutls.el"
 326              doit (gnutls-error-string doit)
 327              (apply #'format-message format (or params '(nil))))))
 328
 329 (provide 'gnutls)
 330
 331 ;;; gnutls.el ends here