Commit | Line | Data |
---|---|---|
8762aa10 | 1 | ;;; gnutls.el --- Support SSL/TLS connections through GnuTLS |
c3dfebd1 | 2 | |
ba318903 | 3 | ;; Copyright (C) 2010-2014 Free Software Foundation, Inc. |
8af55556 TZ |
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/) | |
8762aa10 | 8 | ;; Thanks-To: Lars Magne Ingebrigtsen <larsi@gnus.org> |
8af55556 TZ |
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 | |
8b492194 TZ |
28 | ;; using the corresponding core functions in gnutls.c. It should NOT |
29 | ;; be used directly, only through open-protocol-stream. | |
8af55556 TZ |
30 | |
31 | ;; Simple test: | |
32 | ;; | |
8762aa10 TZ |
33 | ;; (open-gnutls-stream "tls" "tls-buffer" "yourserver.com" "https") |
34 | ;; (open-gnutls-stream "tls" "tls-buffer" "imap.gmail.com" "imaps") | |
8af55556 TZ |
35 | |
36 | ;;; Code: | |
37 | ||
2013a2f9 | 38 | (require 'cl-lib) |
48e79d6a | 39 | |
8ed70bf3 LMI |
40 | (defgroup gnutls nil |
41 | "Emacs interface to the GnuTLS library." | |
2bed3f04 | 42 | :version "24.1" |
8ed70bf3 LMI |
43 | :prefix "gnutls-" |
44 | :group 'net-utils) | |
45 | ||
7b41decb LMI |
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\"." | |
fa9958a6 | 50 | :group 'gnutls |
7b41decb | 51 | :type '(choice (const nil) |
7ee99f32 TZ |
52 | string)) |
53 | ||
31b4827e TZ |
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 | |
b90aa4f4 | 57 | :version "24.4" |
31b4827e TZ |
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 | ||
7ee99f32 TZ |
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 | |
ee0ce425 | 73 | "/usr/ssl/certs/ca-bundle.crt" ; Cygwin |
7ee99f32 TZ |
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")))) | |
7b41decb | 81 | |
87e86684 | 82 | ;;;###autoload |
fcf2993f | 83 | (defcustom gnutls-min-prime-bits 256 |
4f32cc6c CY |
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.) | |
87e86684 | 91 | |
fcf2993f | 92 | A value of nil says to use the default GnuTLS value." |
87e86684 LM |
93 | :type '(choice (const :tag "Use default value" nil) |
94 | (integer :tag "Number of bits" 512)) | |
95 | :group 'gnutls) | |
96 | ||
8762aa10 TZ |
97 | (defun open-gnutls-stream (name buffer host service) |
98 | "Open a SSL/TLS connection for a service to a host. | |
8af55556 TZ |
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 | |
8762aa10 TZ |
110 | specifying a port number to connect to. |
111 | ||
8b492194 TZ |
112 | Usage example: |
113 | ||
114 | \(with-temp-buffer | |
115 | \(open-gnutls-stream \"tls\" | |
116 | \(current-buffer) | |
117 | \"your server goes here\" | |
118 | \"imaps\")) | |
119 | ||
8762aa10 TZ |
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." | |
48e79d6a TZ |
124 | (gnutls-negotiate :process (open-network-stream name buffer host service) |
125 | :type 'gnutls-x509pki | |
126 | :hostname host)) | |
8b492194 | 127 | |
54bd972f | 128 | (define-error 'gnutls-error "GnuTLS error") |
8af55556 | 129 | |
c3dfebd1 | 130 | (declare-function gnutls-boot "gnutls.c" (proc type proplist)) |
cd22b309 | 131 | (declare-function gnutls-errorp "gnutls.c" (error)) |
ffb82dbd | 132 | (defvar gnutls-log-level) ; gnutls.c |
c3dfebd1 | 133 | |
f58e0fd5 | 134 | (cl-defun gnutls-negotiate |
48e79d6a TZ |
135 | (&rest spec |
136 | &key process type hostname priority-string | |
87e86684 LM |
137 | trustfiles crlfiles keylist min-prime-bits |
138 | verify-flags verify-error verify-hostname-error | |
48e79d6a | 139 | &allow-other-keys) |
e9fce1ac | 140 | "Negotiate a SSL/TLS connection. Returns proc. Signals gnutls-error. |
48e79d6a TZ |
141 | |
142 | Note arguments are passed CL style, :type TYPE instead of just TYPE. | |
143 | ||
c1ae068b | 144 | TYPE is `gnutls-x509pki' (default) or `gnutls-anon'. Use nil for the default. |
48e79d6a | 145 | PROCESS is a process returned by `open-network-stream'. |
8b492194 | 146 | HOSTNAME is the remote hostname. It must be a valid string. |
c1ae068b | 147 | PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\". |
7ee99f32 | 148 | TRUSTFILES is a list of CA bundles. It defaults to `gnutls-trustfiles'. |
48e79d6a TZ |
149 | CRLFILES is a list of CRL files. |
150 | KEYLIST is an alist of (client key file, client cert file) pairs. | |
87e86684 LM |
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. | |
8b492194 | 154 | |
31b4827e TZ |
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. | |
8b492194 | 162 | |
31b4827e TZ |
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. | |
8b492194 TZ |
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." | |
c1ae068b | 191 | (let* ((type (or type 'gnutls-x509pki)) |
bc557672 | 192 | (trustfiles (or trustfiles |
7ee99f32 TZ |
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))))) | |
8af55556 TZ |
198 | (priority-string (or priority-string |
199 | (cond | |
c1ae068b | 200 | ((eq type 'gnutls-anon) |
8af55556 | 201 | "NORMAL:+ANON-DH:!ARCFOUR-128") |
c1ae068b | 202 | ((eq type 'gnutls-x509pki) |
7ee99f32 TZ |
203 | (if gnutls-algorithm-priority |
204 | (upcase gnutls-algorithm-priority) | |
205 | "NORMAL"))))) | |
31b4827e TZ |
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) | |
2013a2f9 | 214 | (cl-mapcan |
31b4827e TZ |
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)))) | |
87e86684 | 221 | (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)) |
31b4827e TZ |
222 | params ret) |
223 | ||
224 | (when verify-hostname-error | |
225 | (push :hostname verify-error)) | |
226 | ||
227 | (setq params `(:priority ,priority-string | |
8b492194 | 228 | :hostname ,hostname |
c1ae068b | 229 | :loglevel ,gnutls-log-level |
87e86684 | 230 | :min-prime-bits ,min-prime-bits |
c1ae068b | 231 | :trustfiles ,trustfiles |
48e79d6a TZ |
232 | :crlfiles ,crlfiles |
233 | :keylist ,keylist | |
8b492194 TZ |
234 | :verify-flags ,verify-flags |
235 | :verify-error ,verify-error | |
c1ae068b | 236 | :callbacks nil)) |
8af55556 TZ |
237 | |
238 | (gnutls-message-maybe | |
48e79d6a | 239 | (setq ret (gnutls-boot process type params)) |
8b492194 TZ |
240 | "boot: %s" params) |
241 | ||
242 | (when (gnutls-errorp ret) | |
243 | ;; This is a error from the underlying C code. | |
48e79d6a | 244 | (signal 'gnutls-error (list process ret))) |
8af55556 | 245 | |
48e79d6a | 246 | process)) |
8af55556 | 247 | |
c3dfebd1 GM |
248 | (declare-function gnutls-error-string "gnutls.c" (error)) |
249 | ||
8af55556 TZ |
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 | ||
8af55556 | 259 | (provide 'gnutls) |
8af55556 TZ |
260 | |
261 | ;;; gnutls.el ends here |