gnutls.el 14.9 KB
Newer Older
1
;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2010-2018 Free Software Foundation, Inc.
Ted Zlatanov's avatar
Ted Zlatanov committed
4 5 6 7

;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; Keywords: comm, tls, ssl, encryption
;; Originally-By: Simon Josefsson (See http://josefsson.org/emacs-security/)
8
;; Thanks-To: Lars Magne Ingebrigtsen <larsi@gnus.org>
Ted Zlatanov's avatar
Ted Zlatanov committed
9 10 11 12 13 14 15 16 17 18 19 20 21 22

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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/>.
Ted Zlatanov's avatar
Ted Zlatanov committed
24 25 26 27

;;; Commentary:

;; 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.
Ted Zlatanov's avatar
Ted Zlatanov committed
30 31 32

;; Simple test:
;;
33 34
;; (open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https")
;; (open-gnutls-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")
Ted Zlatanov's avatar
Ted Zlatanov committed
35 36 37

;;; Code:

38
(require 'cl-lib)
39
(require 'puny)
40

41 42
(defgroup gnutls nil
  "Emacs interface to the GnuTLS library."
43
  :version "24.1"
44
  :prefix "gnutls-"
45
  :group 'comm)
46

47 48 49
(defcustom gnutls-algorithm-priority nil
  "If non-nil, this should be a TLS priority string.
For instance, if you want to skip the \"dhe-rsa\" algorithm,
50 51 52 53
set this variable to \"normal:-dhe-rsa\".

This variable can be useful for modifying low-level TLS
connection parameters (for instance if you need to connect to a
54 55 56 57 58
host that only accepts a specific algorithm).  However, in
general, Emacs network security is handled by the Network
Security Manager (NSM), and the default value of nil delegates
the job of checking the connection security to the NSM.
See Info node `(emacs) Network Security'."
59
  :group 'gnutls
60
  :type '(choice (const nil)
61 62
                 string))

63
(defcustom gnutls-verify-error nil
64 65 66 67 68 69 70 71 72
  "If non-nil, this should be t or a list of checks per hostname regex.
If nil, the default, failures in certificate verification will be
logged (subject to `gnutls-log-level'), but the connection will be
allowed to proceed.
If the value is a list, it should have the form

   ((HOST-REGEX FLAGS...) (HOST-REGEX FLAGS...) ...)

where each HOST-REGEX is a regular expression to be matched
73 74 75
against the hostname, on a first-match basis, and FLAGS is either
t or a list of one or more verification flags.  The supported
flags and the corresponding conditions to be tested are:
76 77 78 79 80 81 82 83

  :trustfiles -- certificate must be issued by a trusted authority.
  :hostname   -- hostname must match presented certificate's host name.
  t           -- all of the above conditions are tested.

If the condition test fails, an error will be signaled.

If the value of this variable is t, every connection will be subjected
84 85 86 87 88 89 90
to all of the tests described above.

The default value of this variable is nil, which means that no
checks are performed at the gnutls level.  Instead the checks are
performed via `open-network-stream' at a higher level by the
Network Security Manager.  See Info node `(emacs) Network
Security'."
91
  :group 'gnutls
92
  :version "24.4"
93 94 95 96 97 98 99 100 101 102
  :type '(choice
          (const t)
          (repeat :tag "List of hostname regexps with flags for each"
           (list
            (choice :tag "Hostname"
                    (const ".*" :tag "Any hostname")
                    regexp)
            (set (const :trustfiles)
                 (const :hostname))))))

103 104
(defcustom gnutls-trustfiles
  '(
Ashish SHUKLA's avatar
Ashish SHUKLA committed
105 106 107 108 109
    "/etc/ssl/certs/ca-certificates.crt"     ; Debian, Ubuntu, Gentoo and Arch Linux
    "/etc/pki/tls/certs/ca-bundle.crt"       ; Fedora and RHEL
    "/etc/ssl/ca-bundle.pem"                 ; Suse
    "/usr/ssl/certs/ca-bundle.crt"           ; Cygwin
    "/usr/local/share/certs/ca-root-nss.crt" ; FreeBSD
110
    "/etc/ssl/cert.pem"                      ; macOS
111 112
    )
  "List of CA bundle location filenames or a function returning said list.
113
If a file path contains glob wildcards, they will be expanded.
114 115 116 117 118
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
  :group 'gnutls
  :type '(choice (function :tag "Function to produce list of bundle filenames")
                 (repeat (file :tag "Bundle filename"))))
119

120
;;;###autoload
121
(defcustom gnutls-min-prime-bits 256
122 123 124 125 126 127 128
  ;; Several mail servers send fewer bits than the GnuTLS default.
  ;; Currently, 256 appears to be a reasonable choice (Bug#11267).
  "Minimum number of prime bits accepted by GnuTLS for key exchange.
During a Diffie-Hellman handshake, if the server sends a prime
number with fewer than this number of bits, the handshake is
rejected.  \(The smaller the prime number, the less secure the
key exchange is against man-in-the-middle attacks.)
129

130 131 132 133 134 135 136 137
A value of nil says to use the default GnuTLS value.

The default value of this variable is such that virtually any
connection can be established, whether this connection can be
considered cryptographically \"safe\" or not.  However, Emacs
network security is handled at a higher level via
`open-network-stream' and the Network Security Manager.  See Info
node `(emacs) Network Security'."
138 139 140 141
  :type '(choice (const :tag "Use default value" nil)
                 (integer :tag "Number of bits" 512))
  :group 'gnutls)

142 143 144 145 146 147 148 149 150 151 152 153 154
(defcustom gnutls-crlfiles
  '(
    "/etc/grid-security/certificates/*.crl.pem"
    )
  "List of CRL file paths or a function returning said list.
If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
  :group 'gnutls
  :type '(choice (function :tag "Function to produce list of CRL filenames")
                 (repeat (file :tag "CRL filename")))
  :version "27.1")

155
(defun open-gnutls-stream (name buffer host service &optional nowait)
156
  "Open a SSL/TLS connection for a service to a host.
Ted Zlatanov's avatar
Ted Zlatanov committed
157 158 159 160 161 162
Returns a subprocess-object to represent the connection.
Input and output work as for subprocesses; `delete-process' closes it.
Args are NAME BUFFER HOST SERVICE.
NAME is name for process.  It is modified if necessary to make it unique.
BUFFER is the buffer (or `buffer-name') to associate with the process.
 Process output goes at end of that buffer, unless you specify
163
 a filter function to handle the output.
Ted Zlatanov's avatar
Ted Zlatanov committed
164 165 166 167
 BUFFER may be also nil, meaning that this process is not associated
 with any buffer
Third arg is name of the host to connect to, or its IP address.
Fourth arg SERVICE is name of the service desired, or an integer
168
specifying a port number to connect to.
169
Fifth arg NOWAIT (which is optional) means that the socket should
170 171
be opened asynchronously.  The connection process will be
returned to the caller before TLS negotiation has happened.
172

173 174
Usage example:

175 176 177
  (with-temp-buffer
    (open-gnutls-stream \"tls\"
                        (current-buffer)
178 179 180
                        \"your server goes here\"
                        \"imaps\"))

181 182 183 184
This is a very simple wrapper around `gnutls-negotiate'.  See its
documentation for the specific parameters you can use to open a
GnuTLS connection, including specifying the credential type,
trust and key files, and priority string."
185 186 187 188 189
  (let ((process (open-network-stream
                  name buffer host service
                  :nowait nowait
                  :tls-parameters
                  (and nowait
190 191 192
                       (cons 'gnutls-x509pki
                             (gnutls-boot-parameters
                              :type 'gnutls-x509pki
193
                              :hostname (puny-encode-domain host)))))))
194
    (if nowait
195
        process
196
      (gnutls-negotiate :process process
197
                        :type 'gnutls-x509pki
198
                        :hostname (puny-encode-domain host)))))
199

200
(define-error 'gnutls-error "GnuTLS error")
Ted Zlatanov's avatar
Ted Zlatanov committed
201

202
(declare-function gnutls-boot "gnutls.c" (proc type proplist))
203
(declare-function gnutls-errorp "gnutls.c" (error))
204
(defvar gnutls-log-level)               ; gnutls.c
205

Stefan Monnier's avatar
Stefan Monnier committed
206
(cl-defun gnutls-negotiate
207 208
    (&rest spec
           &key process type hostname priority-string
209 210
           trustfiles crlfiles keylist min-prime-bits
           verify-flags verify-error verify-hostname-error
211
           &allow-other-keys)
Juanma Barranquero's avatar
Juanma Barranquero committed
212
  "Negotiate a SSL/TLS connection.  Returns proc.  Signals gnutls-error.
213

214
Note that arguments are passed CL style, :type TYPE instead of just TYPE.
215 216

PROCESS is a process returned by `open-network-stream'.
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
For the meaning of the rest of the parameters, see `gnutls-boot-parameters'."
  (let* ((type (or type 'gnutls-x509pki))
	 ;; The gnutls library doesn't understand files delivered via
	 ;; the special handlers, so ignore all files found via those.
	 (file-name-handler-alist nil)
         (params (gnutls-boot-parameters
                  :type type
                  :hostname hostname
                  :priority-string priority-string
                  :trustfiles trustfiles
                  :crlfiles crlfiles
                  :keylist keylist
                  :min-prime-bits min-prime-bits
                  :verify-flags verify-flags
                  :verify-error verify-error
                  :verify-hostname-error verify-hostname-error))
         ret)
    (gnutls-message-maybe
235 236 237
     (setq ret (gnutls-boot process type
                            (append (list :complete-negotiation t)
                                    params)))
238 239 240
     "boot: %s" params)

    (when (gnutls-errorp ret)
241
      ;; This is an error from the underlying C code.
242 243 244 245 246 247 248 249 250 251 252 253 254
      (signal 'gnutls-error (list process ret)))

    process))

(cl-defun gnutls-boot-parameters
    (&rest spec
           &key type hostname priority-string
           trustfiles crlfiles keylist min-prime-bits
           verify-flags verify-error verify-hostname-error
           &allow-other-keys)
  "Return a keyword list of parameters suitable for passing to `gnutls-boot'.

TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
255
HOSTNAME is the remote hostname.  It must be a valid string.
256
PRIORITY-STRING is as per the GnuTLS docs, default is based on \"NORMAL\".
257
TRUSTFILES is a list of CA bundles.  It defaults to `gnutls-trustfiles'.
258 259
CRLFILES is a list of CRL files.
KEYLIST is an alist of (client key file, client cert file) pairs.
260 261 262
MIN-PRIME-BITS is the minimum acceptable size of Diffie-Hellman keys
\(see `gnutls-min-prime-bits' for more information).  Use nil for the
default.
263

264 265 266 267 268 269 270
VERIFY-HOSTNAME-ERROR is a backwards compatibility option for
putting `:hostname' in VERIFY-ERROR.

When VERIFY-ERROR is t or a list containing `:trustfiles', an
error will be raised when the peer certificate verification fails
as per GnuTLS' gnutls_certificate_verify_peers2.  Otherwise, only
warnings will be shown about the verification failure.
271

272 273 274 275 276 277 278 279 280 281 282
When VERIFY-ERROR is t or a list containing `:hostname', an error
will be raised when the hostname does not match the presented
certificate's host name.  The exact verification algorithm is a
basic implementation of the matching described in
RFC2818 (HTTPS), which takes into account wildcards, and the
DNSName/IPAddress subject alternative name PKIX extension.  See
GnuTLS' gnutls_x509_crt_check_hostname for details.  Otherwise,
only a warning will be issued.

Note that the list in `gnutls-verify-error', matched against the
HOSTNAME, is the default VERIFY-ERROR.
283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299

VERIFY-FLAGS is a numeric OR of verification flags only for
`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
here's a recent version of the list.

    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256

It must be omitted, a number, or nil; if omitted or nil it
defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
300
  (let* ((trustfiles (or trustfiles (gnutls-trustfiles)))
301
         (crlfiles (or crlfiles (gnutls-crlfiles)))
302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321
         (maybe-dumbfw (if (memq 'ClientHello\ Padding (gnutls-available-p))
                           ":%DUMBFW"
                         ""))
         (priority-string (or priority-string
                              (cond
                               ((eq type 'gnutls-anon)
                                (concat "NORMAL:+ANON-DH:!ARCFOUR-128"
                                        maybe-dumbfw))
                               ((eq type 'gnutls-x509pki)
                                (if gnutls-algorithm-priority
                                    (upcase gnutls-algorithm-priority)
                                  (concat "NORMAL" maybe-dumbfw))))))
         (verify-error (or verify-error
                           ;; this uses the value of `gnutls-verify-error'
                           (cond
                            ;; if t, pass it on
                            ((eq gnutls-verify-error t)
                             t)
                            ;; if a list, look for hostname matches
                            ((listp gnutls-verify-error)
322 323 324
                             (cadr (cl-find-if #'(lambda (x)
                                                   (string-match (car x) hostname))
                                               gnutls-verify-error)))
325 326 327
                            ;; else it's nil
                            (t nil))))
         (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)))
328 329 330 331

    (when verify-hostname-error
      (push :hostname verify-error))

332 333 334 335 336 337 338 339 340 341
    `(:priority ,priority-string
                :hostname ,hostname
                :loglevel ,gnutls-log-level
                :min-prime-bits ,min-prime-bits
                :trustfiles ,trustfiles
                :crlfiles ,crlfiles
                :keylist ,keylist
                :verify-flags ,verify-flags
                :verify-error ,verify-error
                :callbacks nil)))
Ted Zlatanov's avatar
Ted Zlatanov committed
342

343 344 345 346 347
(defun gnutls--get-files (files)
  (cl-loop for f in files
           if f do (setq f (if (functionp f) (funcall f) f))
           append (cl-delete-if-not #'file-exists-p (file-expand-wildcards f t))))

348 349
(defun gnutls-trustfiles ()
  "Return a list of usable trustfiles."
350 351 352 353 354
  (gnutls--get-files gnutls-trustfiles))

(defun gnutls-crlfiles ()
  "Return a list of usable CRL files."
  (gnutls--get-files gnutls-crlfiles))
355

356 357
(declare-function gnutls-error-string "gnutls.c" (error))

Ted Zlatanov's avatar
Ted Zlatanov committed
358 359 360 361 362 363 364
(defun gnutls-message-maybe (doit format &rest params)
  "When DOIT, message with the caller name followed by FORMAT on PARAMS."
  ;; (apply 'debug format (or params '(nil)))
  (when (gnutls-errorp doit)
    (message "%s: (err=[%s] %s) %s"
             "gnutls.el"
             doit (gnutls-error-string doit)
365
             (apply #'format-message format (or params '(nil))))))
Ted Zlatanov's avatar
Ted Zlatanov committed
366 367 368 369

(provide 'gnutls)

;;; gnutls.el ends here