lisp/net/gnutls.el

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