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