1 ;;; gnutls.el --- Support SSL/TLS connections through GnuTLS
3 ;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
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>
10 ;; This file is part of GNU Emacs.
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.
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.
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/>.
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.
33 ;; (open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https")
34 ;; (open-gnutls-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")
41 "Emacs interface to the GnuTLS library."
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\"."
51 :type
'(choice (const nil
)
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
59 If the value is a list, it should have the form
61 ((HOST-REGEX FLAGS...) (HOST-REGEX FLAGS...) ...)
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:
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.
72 If the condition test fails, an error will be signaled.
74 If the value of this variable is t, every connection will be subjected
75 to all of the tests described above."
80 (repeat :tag
"List of hostname regexps with flags for each"
82 (choice :tag
"Hostname"
83 (const ".*" :tag
"Any hostname")
85 (set (const :trustfiles
)
86 (const :hostname
))))))
88 (defcustom gnutls-trustfiles
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
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."
100 :type
'(choice (function :tag
"Function to produce list of bundle filenames")
101 (repeat (file :tag
"Bundle filename"))))
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.)
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))
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
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.
139 (open-gnutls-stream \"tls\"
141 \"your server goes here\"
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
153 (cons 'gnutls-x509pki
154 (gnutls-boot-parameters
155 :type
'gnutls-x509pki
159 (gnutls-negotiate :process process
160 :type
'gnutls-x509pki
163 (define-error 'gnutls-error
"GnuTLS error")
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
169 (cl-defun gnutls-negotiate
171 &key process type hostname priority-string
172 trustfiles crlfiles keylist min-prime-bits
173 verify-flags verify-error verify-hostname-error
175 "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error.
177 Note that arguments are passed CL style, :type TYPE instead of just TYPE.
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
188 :priority-string priority-string
189 :trustfiles trustfiles
192 :min-prime-bits min-prime-bits
193 :verify-flags verify-flags
194 :verify-error verify-error
195 :verify-hostname-error verify-hostname-error
))
197 (gnutls-message-maybe
198 (setq ret
(gnutls-boot process type
199 (append (list :complete-negotiation t
)
203 (when (gnutls-errorp ret
)
204 ;; This is a error from the underlying C code.
205 (signal 'gnutls-error
(list process ret
)))
209 (cl-defun gnutls-boot-parameters
211 &key type hostname priority-string
212 trustfiles crlfiles keylist min-prime-bits
213 verify-flags verify-error verify-hostname-error
215 "Return a keyword list of parameters suitable for passing to `gnutls-boot'.
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
227 VERIFY-HOSTNAME-ERROR is a backwards compatibility option for
228 putting `:hostname' in VERIFY-ERROR.
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.
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.
244 Note that the list in `gnutls-verify-error', matched against the
245 HOSTNAME, is the default VERIFY-ERROR.
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.
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
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
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
)
272 (verify-error (or verify-error
273 ;; this uses the value of `gnutls-verify-error'
276 ((eq gnutls-verify-error t
)
278 ;; if a list, look for hostname matches
279 ((listp gnutls-verify-error
)
283 (when (string-match (nth 0 check
)
286 gnutls-verify-error
)))
289 (min-prime-bits (or min-prime-bits gnutls-min-prime-bits
)))
291 (when verify-hostname-error
292 (push :hostname verify-error
))
294 `(:priority
,priority-string
296 :loglevel
,gnutls-log-level
297 :min-prime-bits
,min-prime-bits
298 :trustfiles
,trustfiles
301 :verify-flags
,verify-flags
302 :verify-error
,verify-error
305 (defun gnutls-trustfiles ()
306 "Return a list of usable trustfiles."
308 (mapcar (lambda (f) (and f
(file-exists-p f
) f
))
309 (if (functionp gnutls-trustfiles
)
310 (funcall gnutls-trustfiles
)
311 gnutls-trustfiles
))))
313 (declare-function gnutls-error-string
"gnutls.c" (error))
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"
321 doit
(gnutls-error-string doit
)
322 (apply #'format-message format
(or params
'(nil))))))
326 ;;; gnutls.el ends here