lisp/net/gnutls.el

   1 ;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
   2
   3 ;; Copyright (C) 2010-2017 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 <http://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     )
  96   "List of CA bundle location filenames or a function returning said list.
  97 The files may be in PEM or DER format, as per the GnuTLS documentation.
  98 The files may not exist, in which case they will be ignored."
  99   :group 'gnutls
 100   :type '(choice (function :tag "Function to produce list of bundle filenames")
 101                  (repeat (file :tag "Bundle filename"))))
 102
 103 ;;;###autoload
 104 (defcustom gnutls-min-prime-bits 256
 105   ;; Several mail servers send fewer bits than the GnuTLS default.
 106   ;; Currently, 256 appears to be a reasonable choice (Bug#11267).
 107   "Minimum number of prime bits accepted by GnuTLS for key exchange.
 108 During a Diffie-Hellman handshake, if the server sends a prime
 109 number with fewer than this number of bits, the handshake is
 110 rejected.  \(The smaller the prime number, the less secure the
 111 key exchange is against man-in-the-middle attacks.)
 112
 113 A value of nil says to use the default GnuTLS value."
 114   :type '(choice (const :tag "Use default value" nil)
 115                  (integer :tag "Number of bits" 512))
 116   :group 'gnutls)
 117
 118 (defun open-gnutls-stream (name buffer host service &optional nowait)
 119   "Open a SSL/TLS connection for a service to a host.
 120 Returns a subprocess-object to represent the connection.
 121 Input and output work as for subprocesses; `delete-process' closes it.
 122 Args are NAME BUFFER HOST SERVICE.
 123 NAME is name for process.  It is modified if necessary to make it unique.
 124 BUFFER is the buffer (or `buffer-name') to associate with the process.
 125  Process output goes at end of that buffer, unless you specify
 126  an output stream or filter function to handle the output.
 127  BUFFER may be also nil, meaning that this process is not associated
 128  with any buffer
 129 Third arg is name of the host to connect to, or its IP address.
 130 Fourth arg SERVICE is name of the service desired, or an integer
 131 specifying a port number to connect to.
 132 Fifth arg NOWAIT (which is optional) means that the socket should
 133 be opened asynchronously.  The connection process will be
 134 returned to the caller before TLS negotiation has happened.
 135
 136 Usage example:
 137
 138   (with-temp-buffer
 139     (open-gnutls-stream \"tls\"
 140                         (current-buffer)
 141                         \"your server goes here\"
 142                         \"imaps\"))
 143
 144 This is a very simple wrapper around `gnutls-negotiate'.  See its
 145 documentation for the specific parameters you can use to open a
 146 GnuTLS connection, including specifying the credential type,
 147 trust and key files, and priority string."
 148   (let ((process (open-network-stream
 149                   name buffer host service
 150                   :nowait nowait
 151                   :tls-parameters
 152                   (and nowait
 153                        (cons 'gnutls-x509pki
 154                              (gnutls-boot-parameters
 155                               :type 'gnutls-x509pki
 156                               :hostname host))))))
 157     (if nowait
 158         process
 159       (gnutls-negotiate :process process
 160                         :type 'gnutls-x509pki
 161                         :hostname host))))
 162
 163 (define-error 'gnutls-error "GnuTLS error")
 164
 165 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 166 (declare-function gnutls-errorp "gnutls.c" (error))
 167 (defvar gnutls-log-level)               ; gnutls.c
 168
 169 (cl-defun gnutls-negotiate
 170     (&rest spec
 171            &key process type hostname priority-string
 172            trustfiles crlfiles keylist min-prime-bits
 173            verify-flags verify-error verify-hostname-error
 174            &allow-other-keys)
 175   "Negotiate a SSL/TLS connection.  Returns proc.  Signals gnutls-error.
 176
 177 Note that arguments are passed CL style, :type TYPE instead of just TYPE.
 178
 179 PROCESS is a process returned by `open-network-stream'.
 180 For the meaning of the rest of the parameters, see `gnutls-boot-parameters'."
 181   (let* ((type (or type 'gnutls-x509pki))
 182          ;; The gnutls library doesn't understand files delivered via
 183          ;; the special handlers, so ignore all files found via those.
 184          (file-name-handler-alist nil)
 185          (params (gnutls-boot-parameters
 186                   :type type
 187                   :hostname hostname
 188                   :priority-string priority-string
 189                   :trustfiles trustfiles
 190                   :crlfiles crlfiles
 191                   :keylist keylist
 192                   :min-prime-bits min-prime-bits
 193                   :verify-flags verify-flags
 194                   :verify-error verify-error
 195                   :verify-hostname-error verify-hostname-error))
 196          ret)
 197     (gnutls-message-maybe
 198      (setq ret (gnutls-boot process type
 199                             (append (list :complete-negotiation t)
 200                                     params)))
 201      "boot: %s" params)
 202
 203     (when (gnutls-errorp ret)
 204       ;; This is a error from the underlying C code.
 205       (signal 'gnutls-error (list process ret)))
 206
 207     process))
 208
 209 (cl-defun gnutls-boot-parameters
 210     (&rest spec
 211            &key type hostname priority-string
 212            trustfiles crlfiles keylist min-prime-bits
 213            verify-flags verify-error verify-hostname-error
 214            &allow-other-keys)
 215   "Return a keyword list of parameters suitable for passing to `gnutls-boot'.
 216
 217 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 218 HOSTNAME is the remote hostname.  It must be a valid string.
 219 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 220 TRUSTFILES is a list of CA bundles.  It defaults to `gnutls-trustfiles'.
 221 CRLFILES is a list of CRL files.
 222 KEYLIST is an alist of (client key file, client cert file) pairs.
 223 MIN-PRIME-BITS is the minimum acceptable size of Diffie-Hellman keys
 224 \(see `gnutls-min-prime-bits' for more information).  Use nil for the
 225 default.
 226
 227 VERIFY-HOSTNAME-ERROR is a backwards compatibility option for
 228 putting `:hostname' in VERIFY-ERROR.
 229
 230 When VERIFY-ERROR is t or a list containing `:trustfiles', an
 231 error will be raised when the peer certificate verification fails
 232 as per GnuTLS' gnutls_certificate_verify_peers2.  Otherwise, only
 233 warnings will be shown about the verification failure.
 234
 235 When VERIFY-ERROR is t or a list containing `:hostname', an error
 236 will be raised when the hostname does not match the presented
 237 certificate's host name.  The exact verification algorithm is a
 238 basic implementation of the matching described in
 239 RFC2818 (HTTPS), which takes into account wildcards, and the
 240 DNSName/IPAddress subject alternative name PKIX extension.  See
 241 GnuTLS' gnutls_x509_crt_check_hostname for details.  Otherwise,
 242 only a warning will be issued.
 243
 244 Note that the list in `gnutls-verify-error', matched against the
 245 HOSTNAME, is the default VERIFY-ERROR.
 246
 247 VERIFY-FLAGS is a numeric OR of verification flags only for
 248 `gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
 249 here's a recent version of the list.
 250
 251     GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
 252     GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
 253     GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
 254     GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
 255     GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
 256     GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
 257     GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
 258     GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
 259     GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
 260
 261 It must be omitted, a number, or nil; if omitted or nil it
 262 defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
 263   (let ((trustfiles (or trustfiles (gnutls-trustfiles)))
 264         (priority-string (or priority-string
 265                              (cond
 266                               ((eq type 'gnutls-anon)
 267                                "NORMAL:+ANON-DH:!ARCFOUR-128")
 268                               ((eq type 'gnutls-x509pki)
 269                                (if gnutls-algorithm-priority
 270                                    (upcase gnutls-algorithm-priority)
 271                                  "NORMAL")))))
 272         (verify-error (or verify-error
 273                           ;; this uses the value of `gnutls-verify-error'
 274                           (cond
 275                            ;; if t, pass it on
 276                            ((eq gnutls-verify-error t)
 277                             t)
 278                            ;; if a list, look for hostname matches
 279                            ((listp gnutls-verify-error)
 280                             (apply 'append
 281                                    (mapcar
 282                                     (lambda (check)
 283                                       (when (string-match (nth 0 check)
 284                                                           hostname)
 285                                         (nth 1 check)))
 286                                     gnutls-verify-error)))
 287                            ;; else it's nil
 288                            (t nil))))
 289         (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)))
 290
 291     (when verify-hostname-error
 292       (push :hostname verify-error))
 293
 294     `(:priority ,priority-string
 295                 :hostname ,hostname
 296                 :loglevel ,gnutls-log-level
 297                 :min-prime-bits ,min-prime-bits
 298                 :trustfiles ,trustfiles
 299                 :crlfiles ,crlfiles
 300                 :keylist ,keylist
 301                 :verify-flags ,verify-flags
 302                 :verify-error ,verify-error
 303                 :callbacks nil)))
 304
 305 (defun gnutls-trustfiles ()
 306   "Return a list of usable trustfiles."
 307   (delq nil
 308         (mapcar (lambda (f) (and f (file-exists-p f) f))
 309                 (if (functionp gnutls-trustfiles)
 310                     (funcall gnutls-trustfiles)
 311                   gnutls-trustfiles))))
 312
 313 (declare-function gnutls-error-string "gnutls.c" (error))
 314
 315 (defun gnutls-message-maybe (doit format &rest params)
 316   "When DOIT, message with the caller name followed by FORMAT on PARAMS."
 317   ;; (apply 'debug format (or params '(nil)))
 318   (when (gnutls-errorp doit)
 319     (message "%s: (err=[%s] %s) %s"
 320              "gnutls.el"
 321              doit (gnutls-error-string doit)
 322              (apply #'format-message format (or params '(nil))))))
 323
 324 (provide 'gnutls)
 325
 326 ;;; gnutls.el ends here