lisp/net/gnutls.el

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