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