This source file includes following definitions.
- init_gnutls_functions
- check_memory_full
- gnutls_audit_log_function
- gnutls_log_function
- gnutls_log_function2
- gnutls_try_handshake
- emacs_gnutls_nonblock_errno
- emacs_gnutls_handshake
- emacs_gnutls_record_check_pending
- emacs_gnutls_transport_set_errno
- emacs_gnutls_write
- emacs_gnutls_read
- emacs_gnutls_strerror
- emacs_gnutls_handle_error
- gnutls_make_error
- gnutls_deinit_certificates
- emacs_gnutls_deinit
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- gnutls_hex_string
- emacs_gnutls_certificate_export_pem
- emacs_gnutls_certificate_details
- DEFUN
- DEFUN
- emacs_gnutls_global_init
- gnutls_ip_address_p
- emacs_gnutls_global_deinit
- ATTRIBUTE_FORMAT_PRINTF
- DEFUN
- gnutls_verify_boot
- key_file2_aux
- DEFUN
- gnutls_symmetric_aead
- gnutls_symmetric
- DEFUN
- DEFUN
- DEFUN
- syms_of_gnutls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 #include <config.h>
20 #include <errno.h>
21 #include <stdio.h>
22
23 #include "lisp.h"
24 #include "process.h"
25 #include "gnutls.h"
26 #include "coding.h"
27 #include "buffer.h"
28 #include "pdumper.h"
29
30 #ifdef HAVE_GNUTLS
31
32 # if GNUTLS_VERSION_NUMBER >= 0x030014
33 # define HAVE_GNUTLS_X509_SYSTEM_TRUST
34 # endif
35
36 # if GNUTLS_VERSION_NUMBER >= 0x030200
37 # define HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
38 # define HAVE_GNUTLS_CIPHER_GET_IV_SIZE
39 # endif
40
41 # if GNUTLS_VERSION_NUMBER >= 0x030202
42 # define HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
43 # define HAVE_GNUTLS_DIGEST_LIST
44 # endif
45
46 # if GNUTLS_VERSION_NUMBER >= 0x030205
47 # define HAVE_GNUTLS_EXT__DUMBFW
48 # endif
49
50 # if GNUTLS_VERSION_NUMBER >= 0x030400
51 # define HAVE_GNUTLS_ETM_STATUS
52 # endif
53
54 # if GNUTLS_VERSION_NUMBER >= 0x030401
55 # define HAVE_GNUTLS_KEYID_USE_SHA256
56 # endif
57
58 # if GNUTLS_VERSION_NUMBER < 0x030600
59 # define HAVE_GNUTLS_COMPRESSION_GET
60 # endif
61
62
63
64 # if GNUTLS_VERSION_NUMBER >= 0x030300
65 # define HAVE_GNUTLS_MAC_GET_NONCE_SIZE
66 # endif
67
68 # if GNUTLS_VERSION_NUMBER >= 0x030501
69 # define HAVE_GNUTLS_EXT_GET_NAME
70 # endif
71
72
73
74
75
76
77
78 # if GNUTLS_VERSION_NUMBER >= 0x030501
79 # define HAVE_GNUTLS_AEAD
80 # endif
81
82 # ifdef WINDOWSNT
83 # include <windows.h>
84 # include "w32common.h"
85 # include "w32.h"
86 # endif
87
88 static int emacs_gnutls_handle_error (gnutls_session_t, int);
89
90 static bool gnutls_global_initialized;
91
92 static void gnutls_log_function (int, const char *);
93 static void gnutls_log_function2 (int, const char *, const char *);
94 # ifdef HAVE_GNUTLS3
95 static void gnutls_audit_log_function (gnutls_session_t, const char *);
96 # endif
97
98 enum extra_peer_verification
99 {
100 CERTIFICATE_NOT_MATCHING = 2
101 };
102
103
104 # ifdef WINDOWSNT
105
106 DEF_DLL_FN (gnutls_alert_description_t, gnutls_alert_get,
107 (gnutls_session_t));
108 DEF_DLL_FN (const char *, gnutls_alert_get_name,
109 (gnutls_alert_description_t));
110 DEF_DLL_FN (int, gnutls_anon_allocate_client_credentials,
111 (gnutls_anon_client_credentials_t *));
112 DEF_DLL_FN (void, gnutls_anon_free_client_credentials,
113 (gnutls_anon_client_credentials_t));
114 DEF_DLL_FN (int, gnutls_bye, (gnutls_session_t, gnutls_close_request_t));
115 DEF_DLL_FN (int, gnutls_certificate_allocate_credentials,
116 (gnutls_certificate_credentials_t *));
117 DEF_DLL_FN (void, gnutls_certificate_free_credentials,
118 (gnutls_certificate_credentials_t));
119 DEF_DLL_FN (const gnutls_datum_t *, gnutls_certificate_get_peers,
120 (gnutls_session_t, unsigned int *));
121 DEF_DLL_FN (void, gnutls_certificate_set_verify_flags,
122 (gnutls_certificate_credentials_t, unsigned int));
123 DEF_DLL_FN (int, gnutls_certificate_set_x509_crl_file,
124 (gnutls_certificate_credentials_t, const char *,
125 gnutls_x509_crt_fmt_t));
126 DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file,
127 (gnutls_certificate_credentials_t, const char *, const char *,
128 gnutls_x509_crt_fmt_t));
129 # ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
130 DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file2,
131 (gnutls_certificate_credentials_t, const char *, const char *,
132 gnutls_x509_crt_fmt_t, const char *, unsigned int));
133 # endif
134 # ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
135 DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust,
136 (gnutls_certificate_credentials_t));
137 # endif
138 DEF_DLL_FN (int, gnutls_certificate_set_x509_trust_file,
139 (gnutls_certificate_credentials_t, const char *,
140 gnutls_x509_crt_fmt_t));
141 DEF_DLL_FN (gnutls_certificate_type_t, gnutls_certificate_type_get,
142 (gnutls_session_t));
143 DEF_DLL_FN (int, gnutls_certificate_verify_peers2,
144 (gnutls_session_t, unsigned int *));
145 DEF_DLL_FN (int, gnutls_credentials_set,
146 (gnutls_session_t, gnutls_credentials_type_t, void *));
147 DEF_DLL_FN (void, gnutls_deinit, (gnutls_session_t));
148 DEF_DLL_FN (void, gnutls_dh_set_prime_bits,
149 (gnutls_session_t, unsigned int));
150 DEF_DLL_FN (int, gnutls_dh_get_prime_bits, (gnutls_session_t));
151 DEF_DLL_FN (int, gnutls_error_is_fatal, (int));
152 DEF_DLL_FN (int, gnutls_global_init, (void));
153 DEF_DLL_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
154 # ifdef HAVE_GNUTLS3
155 DEF_DLL_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func));
156 # endif
157 DEF_DLL_FN (void, gnutls_global_set_log_level, (int));
158 DEF_DLL_FN (int, gnutls_handshake, (gnutls_session_t));
159 DEF_DLL_FN (int, gnutls_init, (gnutls_session_t *, unsigned int));
160 DEF_DLL_FN (int, gnutls_priority_set_direct,
161 (gnutls_session_t, const char *, const char **));
162 DEF_DLL_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
163 DEF_DLL_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
164 DEF_DLL_FN (ssize_t, gnutls_record_send,
165 (gnutls_session_t, const void *, size_t));
166 DEF_DLL_FN (const char *, gnutls_strerror, (int));
167 DEF_DLL_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
168 DEF_DLL_FN (void, gnutls_transport_set_ptr2,
169 (gnutls_session_t, gnutls_transport_ptr_t,
170 gnutls_transport_ptr_t));
171 DEF_DLL_FN (void, gnutls_transport_set_pull_function,
172 (gnutls_session_t, gnutls_pull_func));
173 DEF_DLL_FN (void, gnutls_transport_set_push_function,
174 (gnutls_session_t, gnutls_push_func));
175 DEF_DLL_FN (int, gnutls_x509_crt_check_hostname,
176 (gnutls_x509_crt_t, const char *));
177 DEF_DLL_FN (int, gnutls_x509_crt_check_issuer,
178 (gnutls_x509_crt_t, gnutls_x509_crt_t));
179 DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
180 DEF_DLL_FN (int, gnutls_x509_crt_export,
181 (gnutls_x509_crt_t, gnutls_x509_crt_fmt_t, void *, size_t *));
182 DEF_DLL_FN (int, gnutls_x509_crt_import,
183 (gnutls_x509_crt_t, const gnutls_datum_t *,
184 gnutls_x509_crt_fmt_t));
185 DEF_DLL_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
186 DEF_DLL_FN (int, gnutls_x509_crt_get_fingerprint,
187 (gnutls_x509_crt_t,
188 gnutls_digest_algorithm_t, void *, size_t *));
189 DEF_DLL_FN (int, gnutls_x509_crt_get_version,
190 (gnutls_x509_crt_t));
191 DEF_DLL_FN (int, gnutls_x509_crt_get_serial,
192 (gnutls_x509_crt_t, void *, size_t *));
193 DEF_DLL_FN (int, gnutls_x509_crt_get_issuer_dn,
194 (gnutls_x509_crt_t, char *, size_t *));
195 DEF_DLL_FN (time_t, gnutls_x509_crt_get_activation_time,
196 (gnutls_x509_crt_t));
197 DEF_DLL_FN (time_t, gnutls_x509_crt_get_expiration_time,
198 (gnutls_x509_crt_t));
199 DEF_DLL_FN (int, gnutls_x509_crt_get_dn,
200 (gnutls_x509_crt_t, char *, size_t *));
201 DEF_DLL_FN (int, gnutls_x509_crt_get_pk_algorithm,
202 (gnutls_x509_crt_t, unsigned int *));
203 DEF_DLL_FN (int, gnutls_x509_crt_print,
204 (gnutls_x509_crt_t, gnutls_certificate_print_formats_t,
205 gnutls_datum_t *));
206 DEF_DLL_FN (const char *, gnutls_pk_algorithm_get_name,
207 (gnutls_pk_algorithm_t));
208 DEF_DLL_FN (int, gnutls_pk_bits_to_sec_param,
209 (gnutls_pk_algorithm_t, unsigned int));
210 DEF_DLL_FN (int, gnutls_x509_crt_get_issuer_unique_id,
211 (gnutls_x509_crt_t, char *, size_t *));
212 DEF_DLL_FN (int, gnutls_x509_crt_get_subject_unique_id,
213 (gnutls_x509_crt_t, char *, size_t *));
214 DEF_DLL_FN (int, gnutls_x509_crt_get_signature_algorithm,
215 (gnutls_x509_crt_t));
216 DEF_DLL_FN (int, gnutls_x509_crt_get_key_id,
217 (gnutls_x509_crt_t, unsigned int, unsigned char *, size_t *_size));
218 DEF_DLL_FN (const char *, gnutls_sec_param_get_name, (gnutls_sec_param_t));
219 DEF_DLL_FN (const char *, gnutls_sign_get_name, (gnutls_sign_algorithm_t));
220 DEF_DLL_FN (int, gnutls_server_name_set,
221 (gnutls_session_t, gnutls_server_name_type_t,
222 const void *, size_t));
223 DEF_DLL_FN (gnutls_kx_algorithm_t, gnutls_kx_get, (gnutls_session_t));
224 DEF_DLL_FN (const char *, gnutls_kx_get_name, (gnutls_kx_algorithm_t));
225 DEF_DLL_FN (gnutls_protocol_t, gnutls_protocol_get_version,
226 (gnutls_session_t));
227 DEF_DLL_FN (const char *, gnutls_protocol_get_name, (gnutls_protocol_t));
228 DEF_DLL_FN (gnutls_cipher_algorithm_t, gnutls_cipher_get,
229 (gnutls_session_t));
230 DEF_DLL_FN (const char *, gnutls_cipher_get_name,
231 (gnutls_cipher_algorithm_t));
232 DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
233 DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
234 # ifdef HAVE_GNUTLS_COMPRESSION_GET
235 DEF_DLL_FN (gnutls_compression_method_t, gnutls_compression_get,
236 (gnutls_session_t));
237 DEF_DLL_FN (const char *, gnutls_compression_get_name,
238 (gnutls_compression_method_t));
239 # endif
240 DEF_DLL_FN (unsigned, gnutls_safe_renegotiation_status, (gnutls_session_t));
241
242 # ifdef HAVE_GNUTLS3
243 DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
244 # ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
245 DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
246 # endif
247 DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t));
248 # ifdef HAVE_GNUTLS_DIGEST_LIST
249 DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void));
250 DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t));
251 # endif
252 DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void));
253 # ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
254 DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t));
255 # endif
256 DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t));
257 DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t));
258 # ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
259 DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t));
260 # endif
261 DEF_DLL_FN (int, gnutls_cipher_init,
262 (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t,
263 const gnutls_datum_t *, const gnutls_datum_t *));
264 DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t));
265 DEF_DLL_FN (int, gnutls_cipher_encrypt2,
266 (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
267 DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t));
268 DEF_DLL_FN (int, gnutls_cipher_decrypt2,
269 (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
270 # ifdef HAVE_GNUTLS_AEAD
271 DEF_DLL_FN (int, gnutls_aead_cipher_init,
272 (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t,
273 const gnutls_datum_t *));
274 DEF_DLL_FN (void, gnutls_aead_cipher_deinit, (gnutls_aead_cipher_hd_t));
275 DEF_DLL_FN (int, gnutls_aead_cipher_encrypt,
276 (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
277 size_t, size_t, const void *, size_t, void *, size_t *));
278 DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
279 (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
280 size_t, size_t, const void *, size_t, void *, size_t *));
281 # endif
282 # ifdef HAVE_GNUTLS_ETM_STATUS
283 DEF_DLL_FN (unsigned, gnutls_session_etm_status, (gnutls_session_t));
284 # endif
285 DEF_DLL_FN (int, gnutls_hmac_init,
286 (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
287 DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
288 DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t));
289 DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *));
290 DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *));
291 DEF_DLL_FN (int, gnutls_hash_init,
292 (gnutls_hash_hd_t *, gnutls_digest_algorithm_t));
293 DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t));
294 DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t));
295 DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *));
296 DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *));
297 # ifdef HAVE_GNUTLS_EXT_GET_NAME
298 DEF_DLL_FN (const char *, gnutls_ext_get_name, (unsigned int));
299 # endif
300 # endif
301
302 static gnutls_free_function *gnutls_free_func;
303
304 static bool
305 init_gnutls_functions (void)
306 {
307 HMODULE library;
308 int max_log_level = 1;
309
310 if (!(library = w32_delayed_load (Qgnutls)))
311 {
312 GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
313 return 0;
314 }
315
316 LOAD_DLL_FN (library, gnutls_alert_get);
317 LOAD_DLL_FN (library, gnutls_alert_get_name);
318 LOAD_DLL_FN (library, gnutls_anon_allocate_client_credentials);
319 LOAD_DLL_FN (library, gnutls_anon_free_client_credentials);
320 LOAD_DLL_FN (library, gnutls_bye);
321 LOAD_DLL_FN (library, gnutls_certificate_allocate_credentials);
322 LOAD_DLL_FN (library, gnutls_certificate_free_credentials);
323 LOAD_DLL_FN (library, gnutls_certificate_get_peers);
324 LOAD_DLL_FN (library, gnutls_certificate_set_verify_flags);
325 LOAD_DLL_FN (library, gnutls_certificate_set_x509_crl_file);
326 LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file);
327 # ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
328 LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file2);
329 # endif
330 # ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
331 LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust);
332 # endif
333 LOAD_DLL_FN (library, gnutls_certificate_set_x509_trust_file);
334 LOAD_DLL_FN (library, gnutls_certificate_type_get);
335 LOAD_DLL_FN (library, gnutls_certificate_verify_peers2);
336 LOAD_DLL_FN (library, gnutls_credentials_set);
337 LOAD_DLL_FN (library, gnutls_deinit);
338 LOAD_DLL_FN (library, gnutls_dh_set_prime_bits);
339 LOAD_DLL_FN (library, gnutls_dh_get_prime_bits);
340 LOAD_DLL_FN (library, gnutls_error_is_fatal);
341 LOAD_DLL_FN (library, gnutls_global_init);
342 LOAD_DLL_FN (library, gnutls_global_set_log_function);
343 # ifdef HAVE_GNUTLS3
344 LOAD_DLL_FN (library, gnutls_global_set_audit_log_function);
345 # endif
346 LOAD_DLL_FN (library, gnutls_global_set_log_level);
347 LOAD_DLL_FN (library, gnutls_handshake);
348 LOAD_DLL_FN (library, gnutls_init);
349 LOAD_DLL_FN (library, gnutls_priority_set_direct);
350 LOAD_DLL_FN (library, gnutls_record_check_pending);
351 LOAD_DLL_FN (library, gnutls_record_recv);
352 LOAD_DLL_FN (library, gnutls_record_send);
353 LOAD_DLL_FN (library, gnutls_strerror);
354 LOAD_DLL_FN (library, gnutls_transport_set_errno);
355 LOAD_DLL_FN (library, gnutls_transport_set_ptr2);
356 LOAD_DLL_FN (library, gnutls_transport_set_pull_function);
357 LOAD_DLL_FN (library, gnutls_transport_set_push_function);
358 LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname);
359 LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer);
360 LOAD_DLL_FN (library, gnutls_x509_crt_deinit);
361 LOAD_DLL_FN (library, gnutls_x509_crt_export);
362 LOAD_DLL_FN (library, gnutls_x509_crt_import);
363 LOAD_DLL_FN (library, gnutls_x509_crt_init);
364 LOAD_DLL_FN (library, gnutls_x509_crt_get_fingerprint);
365 LOAD_DLL_FN (library, gnutls_x509_crt_get_version);
366 LOAD_DLL_FN (library, gnutls_x509_crt_get_serial);
367 LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_dn);
368 LOAD_DLL_FN (library, gnutls_x509_crt_get_activation_time);
369 LOAD_DLL_FN (library, gnutls_x509_crt_get_expiration_time);
370 LOAD_DLL_FN (library, gnutls_x509_crt_get_dn);
371 LOAD_DLL_FN (library, gnutls_x509_crt_get_pk_algorithm);
372 LOAD_DLL_FN (library, gnutls_x509_crt_print);
373 LOAD_DLL_FN (library, gnutls_pk_algorithm_get_name);
374 LOAD_DLL_FN (library, gnutls_pk_bits_to_sec_param);
375 LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_unique_id);
376 LOAD_DLL_FN (library, gnutls_x509_crt_get_subject_unique_id);
377 LOAD_DLL_FN (library, gnutls_x509_crt_get_signature_algorithm);
378 LOAD_DLL_FN (library, gnutls_x509_crt_get_key_id);
379 LOAD_DLL_FN (library, gnutls_sec_param_get_name);
380 LOAD_DLL_FN (library, gnutls_sign_get_name);
381 LOAD_DLL_FN (library, gnutls_server_name_set);
382 LOAD_DLL_FN (library, gnutls_kx_get);
383 LOAD_DLL_FN (library, gnutls_kx_get_name);
384 LOAD_DLL_FN (library, gnutls_protocol_get_version);
385 LOAD_DLL_FN (library, gnutls_protocol_get_name);
386 LOAD_DLL_FN (library, gnutls_cipher_get);
387 LOAD_DLL_FN (library, gnutls_cipher_get_name);
388 LOAD_DLL_FN (library, gnutls_mac_get);
389 LOAD_DLL_FN (library, gnutls_mac_get_name);
390 # ifdef HAVE_GNUTLS_COMPRESSION_GET
391 LOAD_DLL_FN (library, gnutls_compression_get);
392 LOAD_DLL_FN (library, gnutls_compression_get_name);
393 # endif
394 LOAD_DLL_FN (library, gnutls_safe_renegotiation_status);
395 # ifdef HAVE_GNUTLS3
396 LOAD_DLL_FN (library, gnutls_mac_list);
397 # ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
398 LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
399 # endif
400 LOAD_DLL_FN (library, gnutls_mac_get_key_size);
401 # ifdef HAVE_GNUTLS_DIGEST_LIST
402 LOAD_DLL_FN (library, gnutls_digest_list);
403 LOAD_DLL_FN (library, gnutls_digest_get_name);
404 # endif
405 LOAD_DLL_FN (library, gnutls_cipher_list);
406 # ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
407 LOAD_DLL_FN (library, gnutls_cipher_get_iv_size);
408 # endif
409 LOAD_DLL_FN (library, gnutls_cipher_get_key_size);
410 LOAD_DLL_FN (library, gnutls_cipher_get_block_size);
411 # ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
412 LOAD_DLL_FN (library, gnutls_cipher_get_tag_size);
413 # endif
414 LOAD_DLL_FN (library, gnutls_cipher_init);
415 LOAD_DLL_FN (library, gnutls_cipher_set_iv);
416 LOAD_DLL_FN (library, gnutls_cipher_encrypt2);
417 LOAD_DLL_FN (library, gnutls_cipher_deinit);
418 LOAD_DLL_FN (library, gnutls_cipher_decrypt2);
419 # ifdef HAVE_GNUTLS_AEAD
420 LOAD_DLL_FN (library, gnutls_aead_cipher_init);
421 LOAD_DLL_FN (library, gnutls_aead_cipher_deinit);
422 LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
423 LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
424 # endif
425 # ifdef HAVE_GNUTLS_ETM_STATUS
426 LOAD_DLL_FN (library, gnutls_session_etm_status);
427 # endif
428 LOAD_DLL_FN (library, gnutls_hmac_init);
429 LOAD_DLL_FN (library, gnutls_hmac_get_len);
430 LOAD_DLL_FN (library, gnutls_hmac);
431 LOAD_DLL_FN (library, gnutls_hmac_deinit);
432 LOAD_DLL_FN (library, gnutls_hmac_output);
433 LOAD_DLL_FN (library, gnutls_hash_init);
434 LOAD_DLL_FN (library, gnutls_hash_get_len);
435 LOAD_DLL_FN (library, gnutls_hash);
436 LOAD_DLL_FN (library, gnutls_hash_deinit);
437 LOAD_DLL_FN (library, gnutls_hash_output);
438 # ifdef HAVE_GNUTLS_EXT_GET_NAME
439 LOAD_DLL_FN (library, gnutls_ext_get_name);
440 # endif
441 # endif
442
443
444
445 gnutls_free_func = (gnutls_free_function *) GetProcAddress (library,
446 "gnutls_free");
447 if (!gnutls_free_func)
448 return false;
449
450 max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
451 {
452 Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from));
453 GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
454 STRINGP (name) ? (const char *) SDATA (name) : "unknown");
455 }
456
457 return 1;
458 }
459
460 # define gnutls_alert_get fn_gnutls_alert_get
461 # define gnutls_alert_get_name fn_gnutls_alert_get_name
462 # define gnutls_anon_allocate_client_credentials fn_gnutls_anon_allocate_client_credentials
463 # define gnutls_anon_free_client_credentials fn_gnutls_anon_free_client_credentials
464 # define gnutls_bye fn_gnutls_bye
465 # define gnutls_certificate_allocate_credentials fn_gnutls_certificate_allocate_credentials
466 # define gnutls_certificate_free_credentials fn_gnutls_certificate_free_credentials
467 # define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers
468 # define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags
469 # define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file
470 # define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file
471 # ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
472 # define gnutls_certificate_set_x509_key_file2 fn_gnutls_certificate_set_x509_key_file2
473 # endif
474 # define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust
475 # define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file
476 # define gnutls_certificate_type_get fn_gnutls_certificate_type_get
477 # define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2
478 # define gnutls_cipher_get fn_gnutls_cipher_get
479 # define gnutls_cipher_get_name fn_gnutls_cipher_get_name
480 # define gnutls_credentials_set fn_gnutls_credentials_set
481 # define gnutls_deinit fn_gnutls_deinit
482 # define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits
483 # define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits
484 # define gnutls_error_is_fatal fn_gnutls_error_is_fatal
485 # define gnutls_global_init fn_gnutls_global_init
486 # define gnutls_global_set_audit_log_function fn_gnutls_global_set_audit_log_function
487 # define gnutls_global_set_log_function fn_gnutls_global_set_log_function
488 # define gnutls_global_set_log_level fn_gnutls_global_set_log_level
489 # define gnutls_handshake fn_gnutls_handshake
490 # define gnutls_init fn_gnutls_init
491 # define gnutls_kx_get fn_gnutls_kx_get
492 # define gnutls_kx_get_name fn_gnutls_kx_get_name
493 # define gnutls_mac_get fn_gnutls_mac_get
494 # define gnutls_mac_get_name fn_gnutls_mac_get_name
495 # ifdef HAVE_GNUTLS_COMPRESSION_GET
496 # define gnutls_compression_get fn_gnutls_compression_get
497 # define gnutls_compression_get_name fn_gnutls_compression_get_name
498 # endif
499 # define gnutls_safe_renegotiation_status fn_gnutls_safe_renegotiation_status
500 # define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
501 # define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
502 # define gnutls_priority_set_direct fn_gnutls_priority_set_direct
503 # define gnutls_protocol_get_name fn_gnutls_protocol_get_name
504 # define gnutls_protocol_get_version fn_gnutls_protocol_get_version
505 # define gnutls_record_check_pending fn_gnutls_record_check_pending
506 # define gnutls_record_recv fn_gnutls_record_recv
507 # define gnutls_record_send fn_gnutls_record_send
508 # define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name
509 # define gnutls_server_name_set fn_gnutls_server_name_set
510 # define gnutls_sign_get_name fn_gnutls_sign_get_name
511 # define gnutls_strerror fn_gnutls_strerror
512 # define gnutls_transport_set_errno fn_gnutls_transport_set_errno
513 # define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2
514 # define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function
515 # define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function
516 # define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
517 # define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
518 # define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
519 # define gnutls_x509_crt_export fn_gnutls_x509_crt_export
520 # define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
521 # define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
522 # define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time
523 # define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint
524 # define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn
525 # define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id
526 # define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
527 # define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
528 # define gnutls_x509_crt_print fn_gnutls_x509_crt_print
529 # define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
530 # define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
531 # define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
532 # define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
533 # define gnutls_x509_crt_import fn_gnutls_x509_crt_import
534 # define gnutls_x509_crt_init fn_gnutls_x509_crt_init
535 # ifdef HAVE_GNUTLS3
536 # define gnutls_mac_list fn_gnutls_mac_list
537 # ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
538 # define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
539 # endif
540 # define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
541 # ifdef HAVE_GNUTLS_DIGEST_LIST
542 # define gnutls_digest_list fn_gnutls_digest_list
543 # define gnutls_digest_get_name fn_gnutls_digest_get_name
544 # endif
545 # define gnutls_cipher_list fn_gnutls_cipher_list
546 # ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
547 # define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
548 # endif
549 # define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
550 # define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
551 # ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
552 # define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
553 # endif
554 # define gnutls_cipher_init fn_gnutls_cipher_init
555 # define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv
556 # define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2
557 # define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2
558 # define gnutls_cipher_deinit fn_gnutls_cipher_deinit
559 # ifdef HAVE_GNUTLS_AEAD
560 # define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt
561 # define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt
562 # define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
563 # define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
564 # endif
565 # ifdef HAVE_GNUTLS_ETM_STATUS
566 # define gnutls_session_etm_status fn_gnutls_session_etm_status
567 # endif
568 # define gnutls_hmac_init fn_gnutls_hmac_init
569 # define gnutls_hmac_get_len fn_gnutls_hmac_get_len
570 # define gnutls_hmac fn_gnutls_hmac
571 # define gnutls_hmac_deinit fn_gnutls_hmac_deinit
572 # define gnutls_hmac_output fn_gnutls_hmac_output
573 # define gnutls_hash_init fn_gnutls_hash_init
574 # define gnutls_hash_get_len fn_gnutls_hash_get_len
575 # define gnutls_hash fn_gnutls_hash
576 # define gnutls_hash_deinit fn_gnutls_hash_deinit
577 # define gnutls_hash_output fn_gnutls_hash_output
578 # ifdef HAVE_GNUTLS_EXT_GET_NAME
579 # define gnutls_ext_get_name fn_gnutls_ext_get_name
580 # endif
581 # endif
582
583
584
585
586 # undef gnutls_free
587 # define gnutls_free (*gnutls_free_func)
588
589 # endif
590
591
592
593 static void
594 check_memory_full (int err)
595 {
596
597
598
599 if (err == GNUTLS_E_MEMORY_ERROR)
600 memory_full (0);
601 }
602
603 # ifdef HAVE_GNUTLS3
604
605 static void
606 gnutls_audit_log_function (gnutls_session_t session, const char *string)
607 {
608 if (global_gnutls_log_level >= 1)
609 {
610 message ("gnutls.c: [audit] %s", string);
611 }
612 }
613 # endif
614
615
616 static void
617 gnutls_log_function (int level, const char *string)
618 {
619 message ("gnutls.c: [%d] %s", level, string);
620 }
621
622
623 static void
624 gnutls_log_function2 (int level, const char *string, const char *extra)
625 {
626 message ("gnutls.c: [%d] %s %s", level, string, extra);
627 }
628
629 int
630 gnutls_try_handshake (struct Lisp_Process *proc)
631 {
632 gnutls_session_t state = proc->gnutls_state;
633 int ret;
634 bool non_blocking = proc->is_non_blocking_client;
635
636
637 struct timespec delay = { 0, 1000 * 1000 * 10 };
638
639 if (proc->gnutls_complete_negotiation_p)
640 non_blocking = false;
641
642 if (non_blocking)
643 proc->gnutls_p = true;
644
645 while ((ret = gnutls_handshake (state)) < 0)
646 {
647 if (emacs_gnutls_handle_error (state, ret) == 0)
648 break;
649 maybe_quit ();
650 if (non_blocking && ret != GNUTLS_E_INTERRUPTED)
651 break;
652 nanosleep (&delay, NULL);
653 }
654
655 proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
656
657 if (ret == GNUTLS_E_SUCCESS)
658 {
659
660 proc->gnutls_initstage = GNUTLS_STAGE_READY;
661 }
662 else
663 {
664
665 }
666 return ret;
667 }
668
669 # ifndef WINDOWSNT
670 static int
671 emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
672 {
673 int err = errno;
674
675 switch (err)
676 {
677 # ifdef _AIX
678
679
680 case 0:
681 errno = EAGAIN;
682
683 # endif
684 case EINPROGRESS:
685 case ENOTCONN:
686 return EAGAIN;
687
688 default:
689 return err;
690 }
691 }
692 # endif
693
694 static int
695 emacs_gnutls_handshake (struct Lisp_Process *proc)
696 {
697 gnutls_session_t state = proc->gnutls_state;
698
699 if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
700 return -1;
701
702 if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
703 {
704 # ifdef WINDOWSNT
705
706
707
708 gnutls_transport_set_ptr2 (state,
709 (gnutls_transport_ptr_t) proc,
710 (gnutls_transport_ptr_t) proc);
711 gnutls_transport_set_push_function (state, &emacs_gnutls_push);
712 gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
713 # else
714
715
716
717 gnutls_transport_set_ptr2 (state,
718 (void *) (intptr_t) proc->infd,
719 (void *) (intptr_t) proc->outfd);
720 if (proc->is_non_blocking_client)
721 gnutls_transport_set_errno_function (state,
722 emacs_gnutls_nonblock_errno);
723 # endif
724
725 proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
726 }
727
728 return gnutls_try_handshake (proc);
729 }
730
731 ptrdiff_t
732 emacs_gnutls_record_check_pending (gnutls_session_t state)
733 {
734 return gnutls_record_check_pending (state);
735 }
736
737 # ifdef WINDOWSNT
738 void
739 emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
740 {
741 gnutls_transport_set_errno (state, err);
742 }
743 # endif
744
745 ptrdiff_t
746 emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
747 {
748 gnutls_session_t state = proc->gnutls_state;
749
750 if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
751 {
752 errno = EAGAIN;
753 return 0;
754 }
755
756 ptrdiff_t bytes_written = 0;
757
758 while (nbyte > 0)
759 {
760 ssize_t rtnval;
761 do
762 rtnval = gnutls_record_send (state, buf, nbyte);
763 while (rtnval == GNUTLS_E_INTERRUPTED);
764
765 if (rtnval < 0)
766 {
767 emacs_gnutls_handle_error (state, rtnval);
768 break;
769 }
770
771 buf += rtnval;
772 nbyte -= rtnval;
773 bytes_written += rtnval;
774 }
775
776 return (bytes_written);
777 }
778
779 ptrdiff_t
780 emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
781 {
782 gnutls_session_t state = proc->gnutls_state;
783
784 if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
785 {
786 errno = EAGAIN;
787 return -1;
788 }
789
790 ssize_t rtnval;
791 do
792 rtnval = gnutls_record_recv (state, buf, nbyte);
793 while (rtnval == GNUTLS_E_INTERRUPTED);
794
795 if (rtnval >= 0)
796 return rtnval;
797 else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
798
799 return 0;
800 else
801 return emacs_gnutls_handle_error (state, rtnval);
802 }
803
804 static char const *
805 emacs_gnutls_strerror (int err)
806 {
807 char const *str = gnutls_strerror (err);
808 return str ? str : "unknown";
809 }
810
811
812
813
814
815 static int
816 emacs_gnutls_handle_error (gnutls_session_t session, int err)
817 {
818 int ret;
819
820
821
822 check_memory_full (err);
823
824 int max_log_level
825 = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
826
827
828
829 char const *str = emacs_gnutls_strerror (err);
830 int errnum = EINVAL;
831
832 if (gnutls_error_is_fatal (err))
833 {
834 int level = 1;
835
836
837
838 # ifdef HAVE_GNUTLS3
839 if (err == GNUTLS_E_PREMATURE_TERMINATION)
840 level = 3;
841 # endif
842
843 GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
844 ret = 0;
845 }
846 else
847 {
848 ret = -1;
849
850 switch (err)
851 {
852 case GNUTLS_E_AGAIN:
853 GNUTLS_LOG2 (3,
854 max_log_level,
855 "retry:",
856 str);
857 FALLTHROUGH;
858 default:
859 GNUTLS_LOG2 (1,
860 max_log_level,
861 "non-fatal error:",
862 str);
863 }
864
865 switch (err)
866 {
867 case GNUTLS_E_AGAIN:
868 errnum = EAGAIN;
869 break;
870
871 # ifdef EMSGSIZE
872 case GNUTLS_E_LARGE_PACKET:
873 case GNUTLS_E_PUSH_ERROR:
874 errnum = EMSGSIZE;
875 break;
876 # endif
877
878 # if defined HAVE_GNUTLS3 && defined ECONNRESET
879 case GNUTLS_E_PREMATURE_TERMINATION:
880 errnum = ECONNRESET;
881 break;
882 # endif
883 }
884 }
885
886 if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
887 || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
888 {
889 int alert = gnutls_alert_get (session);
890 int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
891 str = gnutls_alert_get_name (alert);
892 if (!str)
893 str = "unknown";
894
895 GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str);
896 }
897
898 errno = errnum;
899 return ret;
900 }
901
902
903
904
905
906 static Lisp_Object
907 gnutls_make_error (int err)
908 {
909 switch (err)
910 {
911 case GNUTLS_E_SUCCESS:
912 return Qt;
913 case GNUTLS_E_AGAIN:
914 return Qgnutls_e_again;
915 case GNUTLS_E_INTERRUPTED:
916 return Qgnutls_e_interrupted;
917 case GNUTLS_E_INVALID_SESSION:
918 return Qgnutls_e_invalid_session;
919 }
920
921 check_memory_full (err);
922 return make_fixnum (err);
923 }
924
925 static void
926 gnutls_deinit_certificates (struct Lisp_Process *p)
927 {
928 if (! p->gnutls_certificates)
929 return;
930
931 for (int i = 0; i < p->gnutls_certificates_length; i++)
932 gnutls_x509_crt_deinit (p->gnutls_certificates[i]);
933
934 xfree (p->gnutls_certificates);
935 p->gnutls_certificates = NULL;
936 }
937
938 Lisp_Object
939 emacs_gnutls_deinit (Lisp_Object proc)
940 {
941 int log_level;
942
943 CHECK_PROCESS (proc);
944
945 if (! XPROCESS (proc)->gnutls_p)
946 return Qnil;
947
948 log_level = XPROCESS (proc)->gnutls_log_level;
949
950 if (XPROCESS (proc)->gnutls_x509_cred)
951 {
952 GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
953 gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
954 XPROCESS (proc)->gnutls_x509_cred = NULL;
955 }
956
957 if (XPROCESS (proc)->gnutls_anon_cred)
958 {
959 GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
960 gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
961 XPROCESS (proc)->gnutls_anon_cred = NULL;
962 }
963
964 if (XPROCESS (proc)->gnutls_state)
965 {
966 gnutls_deinit (XPROCESS (proc)->gnutls_state);
967 XPROCESS (proc)->gnutls_state = NULL;
968 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
969 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
970 }
971
972 if (XPROCESS (proc)->gnutls_certificates)
973 gnutls_deinit_certificates (XPROCESS (proc));
974
975 XPROCESS (proc)->gnutls_p = false;
976 return Qt;
977 }
978
979 DEFUN ("gnutls-asynchronous-parameters", Fgnutls_asynchronous_parameters,
980 Sgnutls_asynchronous_parameters, 2, 2, 0,
981 doc:
982
983 )
984 (Lisp_Object proc, Lisp_Object params)
985 {
986 CHECK_PROCESS (proc);
987
988 XPROCESS (proc)->gnutls_boot_parameters = params;
989 return Qnil;
990 }
991
992 DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
993 doc:
994 )
995 (Lisp_Object proc)
996 {
997 CHECK_PROCESS (proc);
998
999 return make_fixnum (GNUTLS_INITSTAGE (proc));
1000 }
1001
1002 DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
1003 doc:
1004
1005
1006 attributes: const)
1007 (Lisp_Object err)
1008 {
1009 if (EQ (err, Qt)
1010 || EQ (err, Qgnutls_e_again))
1011 return Qnil;
1012
1013 return Qt;
1014 }
1015
1016 DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0,
1017 doc:
1018
1019 )
1020 (Lisp_Object err)
1021 {
1022 Lisp_Object code;
1023
1024 if (EQ (err, Qt)) return Qnil;
1025
1026 if (SYMBOLP (err))
1027 {
1028 code = Fget (err, Qgnutls_code);
1029 if (NUMBERP (code))
1030 {
1031 err = code;
1032 }
1033 else
1034 {
1035 error ("Symbol has no numeric gnutls-code property");
1036 }
1037 }
1038
1039 if (! TYPE_RANGED_FIXNUMP (int, err))
1040 error ("Not an error symbol or code");
1041
1042 if (0 == gnutls_error_is_fatal (XFIXNUM (err)))
1043 return Qnil;
1044
1045 return Qt;
1046 }
1047
1048 DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0,
1049 doc:
1050
1051 )
1052 (Lisp_Object err)
1053 {
1054 Lisp_Object code;
1055
1056 if (EQ (err, Qt)) return build_string ("Not an error");
1057
1058 if (SYMBOLP (err))
1059 {
1060 code = Fget (err, Qgnutls_code);
1061 if (NUMBERP (code))
1062 {
1063 err = code;
1064 }
1065 else
1066 {
1067 return build_string ("Symbol has no numeric gnutls-code property");
1068 }
1069 }
1070
1071 if (! TYPE_RANGED_FIXNUMP (int, err))
1072 return build_string ("Not an error symbol or code");
1073
1074 return build_string (emacs_gnutls_strerror (XFIXNUM (err)));
1075 }
1076
1077 DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
1078 doc:
1079 )
1080 (Lisp_Object proc)
1081 {
1082 return emacs_gnutls_deinit (proc);
1083 }
1084
1085 static Lisp_Object
1086 gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
1087 {
1088 ptrdiff_t prefix_length = strlen (prefix);
1089 ptrdiff_t retlen;
1090 if (ckd_mul (&retlen, buf_size, 3)
1091 || ckd_add (&retlen, retlen, prefix_length - (buf_size != 0)))
1092 string_overflow ();
1093 Lisp_Object ret = make_uninit_string (retlen);
1094 char *string = SSDATA (ret);
1095 strcpy (string, prefix);
1096
1097 for (ptrdiff_t i = 0; i < buf_size; i++)
1098 sprintf (string + i * 3 + prefix_length,
1099 i == buf_size - 1 ? "%02x" : "%02x:",
1100 buf[i]);
1101
1102 return ret;
1103 }
1104
1105 static Lisp_Object
1106 emacs_gnutls_certificate_export_pem (gnutls_x509_crt_t cert)
1107 {
1108 size_t size = 0;
1109 int err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, NULL, &size);
1110 check_memory_full (err);
1111
1112 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1113 {
1114 USE_SAFE_ALLOCA;
1115 char *buf = SAFE_ALLOCA (size);
1116 err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, buf, &size);
1117 check_memory_full (err);
1118
1119 if (err < GNUTLS_E_SUCCESS)
1120 error ("GnuTLS certificate export error: %s",
1121 emacs_gnutls_strerror (err));
1122
1123 Lisp_Object result = build_string (buf);
1124 SAFE_FREE ();
1125 return result;
1126 }
1127 else if (err < GNUTLS_E_SUCCESS)
1128 error ("GnuTLS certificate export error: %s", emacs_gnutls_strerror (err));
1129
1130 return Qnil;
1131 }
1132
1133 static Lisp_Object
1134 emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
1135 {
1136 Lisp_Object res = Qnil;
1137 int err;
1138 size_t buf_size;
1139
1140
1141 {
1142 int version = gnutls_x509_crt_get_version (cert);
1143 check_memory_full (version);
1144 if (version >= GNUTLS_E_SUCCESS)
1145 res = nconc2 (res, list2 (intern (":version"),
1146 make_fixnum (version)));
1147 }
1148
1149
1150 buf_size = 0;
1151 err = gnutls_x509_crt_get_serial (cert, NULL, &buf_size);
1152 check_memory_full (err);
1153 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1154 {
1155 void *serial = xmalloc (buf_size);
1156 err = gnutls_x509_crt_get_serial (cert, serial, &buf_size);
1157 check_memory_full (err);
1158 if (err >= GNUTLS_E_SUCCESS)
1159 res = nconc2 (res, list2 (intern (":serial-number"),
1160 gnutls_hex_string (serial, buf_size, "")));
1161 xfree (serial);
1162 }
1163
1164
1165 buf_size = 0;
1166 err = gnutls_x509_crt_get_issuer_dn (cert, NULL, &buf_size);
1167 check_memory_full (err);
1168 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1169 {
1170 char *dn = xmalloc (buf_size);
1171 err = gnutls_x509_crt_get_issuer_dn (cert, dn, &buf_size);
1172 check_memory_full (err);
1173 if (err >= GNUTLS_E_SUCCESS)
1174 res = nconc2 (res, list2 (intern (":issuer"),
1175 make_string (dn, buf_size)));
1176 xfree (dn);
1177 }
1178
1179
1180 {
1181
1182
1183 char buf[INT_STRLEN_BOUND (int) + 1 + sizeof "-12-31"];
1184 struct tm t;
1185 time_t tim = gnutls_x509_crt_get_activation_time (cert);
1186
1187 if (gmtime_r (&tim, &t) && strftime (buf, sizeof buf, "%Y-%m-%d", &t))
1188 res = nconc2 (res, list2 (intern (":valid-from"), build_string (buf)));
1189
1190 tim = gnutls_x509_crt_get_expiration_time (cert);
1191 if (gmtime_r (&tim, &t) && strftime (buf, sizeof buf, "%Y-%m-%d", &t))
1192 res = nconc2 (res, list2 (intern (":valid-to"), build_string (buf)));
1193 }
1194
1195
1196 buf_size = 0;
1197 err = gnutls_x509_crt_get_dn (cert, NULL, &buf_size);
1198 check_memory_full (err);
1199 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1200 {
1201 char *dn = xmalloc (buf_size);
1202 err = gnutls_x509_crt_get_dn (cert, dn, &buf_size);
1203 check_memory_full (err);
1204 if (err >= GNUTLS_E_SUCCESS)
1205 res = nconc2 (res, list2 (intern (":subject"),
1206 make_string (dn, buf_size)));
1207 xfree (dn);
1208 }
1209
1210
1211 {
1212 unsigned int bits;
1213
1214 err = gnutls_x509_crt_get_pk_algorithm (cert, &bits);
1215 check_memory_full (err);
1216 if (err >= GNUTLS_E_SUCCESS)
1217 {
1218 const char *name = gnutls_pk_algorithm_get_name (err);
1219 if (name)
1220 res = nconc2 (res, list2 (intern (":public-key-algorithm"),
1221 build_string (name)));
1222
1223 name = gnutls_sec_param_get_name (gnutls_pk_bits_to_sec_param
1224 (err, bits));
1225 res = nconc2 (res, list2 (intern (":certificate-security-level"),
1226 build_string (name)));
1227 }
1228 }
1229
1230
1231 buf_size = 0;
1232 err = gnutls_x509_crt_get_issuer_unique_id (cert, NULL, &buf_size);
1233 check_memory_full (err);
1234 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1235 {
1236 char *buf = xmalloc (buf_size);
1237 err = gnutls_x509_crt_get_issuer_unique_id (cert, buf, &buf_size);
1238 check_memory_full (err);
1239 if (err >= GNUTLS_E_SUCCESS)
1240 res = nconc2 (res, list2 (intern (":issuer-unique-id"),
1241 make_string (buf, buf_size)));
1242 xfree (buf);
1243 }
1244
1245 buf_size = 0;
1246 err = gnutls_x509_crt_get_subject_unique_id (cert, NULL, &buf_size);
1247 check_memory_full (err);
1248 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1249 {
1250 char *buf = xmalloc (buf_size);
1251 err = gnutls_x509_crt_get_subject_unique_id (cert, buf, &buf_size);
1252 check_memory_full (err);
1253 if (err >= GNUTLS_E_SUCCESS)
1254 res = nconc2 (res, list2 (intern (":subject-unique-id"),
1255 make_string (buf, buf_size)));
1256 xfree (buf);
1257 }
1258
1259
1260 err = gnutls_x509_crt_get_signature_algorithm (cert);
1261 check_memory_full (err);
1262 if (err >= GNUTLS_E_SUCCESS)
1263 {
1264 const char *name = gnutls_sign_get_name (err);
1265 if (name)
1266 res = nconc2 (res, list2 (intern (":signature-algorithm"),
1267 build_string (name)));
1268 }
1269
1270
1271 buf_size = 0;
1272 err = gnutls_x509_crt_get_key_id (cert, 0, NULL, &buf_size);
1273 check_memory_full (err);
1274 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1275 {
1276 void *buf = xmalloc (buf_size);
1277 err = gnutls_x509_crt_get_key_id (cert, 0, buf, &buf_size);
1278 check_memory_full (err);
1279 if (err >= GNUTLS_E_SUCCESS)
1280 res = nconc2 (res, list2 (intern (":public-key-id"),
1281 gnutls_hex_string (buf, buf_size, "sha1:")));
1282 xfree (buf);
1283 }
1284
1285 #ifdef HAVE_GNUTLS_KEYID_USE_SHA256
1286
1287 buf_size = 0;
1288 err = gnutls_x509_crt_get_key_id (cert, GNUTLS_KEYID_USE_SHA256, NULL, &buf_size);
1289 check_memory_full (err);
1290 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1291 {
1292 void *buf = xmalloc (buf_size);
1293 err = gnutls_x509_crt_get_key_id (cert, GNUTLS_KEYID_USE_SHA256, buf, &buf_size);
1294 check_memory_full (err);
1295 if (err >= GNUTLS_E_SUCCESS)
1296 res = nconc2 (res, list2 (intern (":public-key-id-sha256"),
1297 gnutls_hex_string (buf, buf_size, "sha256:")));
1298 xfree (buf);
1299 }
1300 #endif
1301
1302
1303 buf_size = 0;
1304 err = gnutls_x509_crt_get_fingerprint (cert, GNUTLS_DIG_SHA1,
1305 NULL, &buf_size);
1306 check_memory_full (err);
1307 if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
1308 {
1309 void *buf = xmalloc (buf_size);
1310 err = gnutls_x509_crt_get_fingerprint (cert, GNUTLS_DIG_SHA1,
1311 buf, &buf_size);
1312 check_memory_full (err);
1313 if (err >= GNUTLS_E_SUCCESS)
1314 res = nconc2 (res, list2 (intern (":certificate-id"),
1315 gnutls_hex_string (buf, buf_size, "sha1:")));
1316 xfree (buf);
1317 }
1318
1319
1320 res = nconc2 (res, list2 (intern (":pem"),
1321 emacs_gnutls_certificate_export_pem(cert)));
1322
1323 return res;
1324 }
1325
1326 DEFUN ("gnutls-peer-status-warning-describe", Fgnutls_peer_status_warning_describe, Sgnutls_peer_status_warning_describe, 1, 1, 0,
1327 doc: )
1328 (Lisp_Object status_symbol)
1329 {
1330 CHECK_SYMBOL (status_symbol);
1331
1332 if (EQ (status_symbol, intern (":invalid")))
1333 return build_string ("certificate could not be verified");
1334
1335 if (EQ (status_symbol, intern (":revoked")))
1336 return build_string ("certificate was revoked (CRL)");
1337
1338 if (EQ (status_symbol, intern (":self-signed")))
1339 return build_string ("certificate signer was not found (self-signed)");
1340
1341 if (EQ (status_symbol, intern (":unknown-ca")))
1342 return build_string ("the certificate was signed by an unknown "
1343 "and therefore untrusted authority");
1344
1345 if (EQ (status_symbol, intern (":not-ca")))
1346 return build_string ("certificate signer is not a CA");
1347
1348 if (EQ (status_symbol, intern (":insecure")))
1349 return build_string ("certificate was signed with an insecure algorithm");
1350
1351 if (EQ (status_symbol, intern (":not-activated")))
1352 return build_string ("certificate is not yet activated");
1353
1354 if (EQ (status_symbol, intern (":expired")))
1355 return build_string ("certificate has expired");
1356
1357 if (EQ (status_symbol, intern (":no-host-match")))
1358 return build_string ("certificate host does not match hostname");
1359
1360 if (EQ (status_symbol, intern (":signature-failure")))
1361 return build_string ("certificate signature could not be verified");
1362
1363 if (EQ (status_symbol, intern (":revocation-data-superseded")))
1364 return build_string ("certificate revocation data are old and have been "
1365 "superseded");
1366
1367 if (EQ (status_symbol, intern (":revocation-data-issued-in-future")))
1368 return build_string ("certificate revocation data have a future issue date");
1369
1370 if (EQ (status_symbol, intern (":signer-constraints-failure")))
1371 return build_string ("certificate signer constraints were violated");
1372
1373 if (EQ (status_symbol, intern (":purpose-mismatch")))
1374 return build_string ("certificate does not match the intended purpose");
1375
1376 if (EQ (status_symbol, intern (":missing-ocsp-status")))
1377 return build_string ("certificate requires the server to send a OCSP "
1378 "certificate status, but no status was received");
1379
1380 if (EQ (status_symbol, intern (":invalid-ocsp-status")))
1381 return build_string ("the received OCSP certificate status is invalid");
1382
1383 return Qnil;
1384 }
1385
1386 DEFUN ("gnutls-peer-status", Fgnutls_peer_status, Sgnutls_peer_status, 1, 1, 0,
1387 doc:
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398 )
1399 (Lisp_Object proc)
1400 {
1401 Lisp_Object warnings = Qnil, result = Qnil;
1402 unsigned int verification;
1403 gnutls_session_t state;
1404
1405 CHECK_PROCESS (proc);
1406
1407 if (GNUTLS_INITSTAGE (proc) != GNUTLS_STAGE_READY)
1408 return Qnil;
1409
1410
1411 verification = XPROCESS (proc)->gnutls_peer_verification;
1412
1413 if (verification & GNUTLS_CERT_INVALID)
1414 warnings = Fcons (intern (":invalid"), warnings);
1415
1416 if (verification & GNUTLS_CERT_REVOKED)
1417 warnings = Fcons (intern (":revoked"), warnings);
1418
1419 if (verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
1420 warnings = Fcons (intern (":unknown-ca"), warnings);
1421
1422 if (verification & GNUTLS_CERT_SIGNER_NOT_CA)
1423 warnings = Fcons (intern (":not-ca"), warnings);
1424
1425 if (verification & GNUTLS_CERT_INSECURE_ALGORITHM)
1426 warnings = Fcons (intern (":insecure"), warnings);
1427
1428 if (verification & GNUTLS_CERT_NOT_ACTIVATED)
1429 warnings = Fcons (intern (":not-activated"), warnings);
1430
1431 if (verification & GNUTLS_CERT_EXPIRED)
1432 warnings = Fcons (intern (":expired"), warnings);
1433
1434 # if GNUTLS_VERSION_NUMBER >= 0x030100
1435 if (verification & GNUTLS_CERT_SIGNATURE_FAILURE)
1436 warnings = Fcons (intern (":signature-failure"), warnings);
1437
1438 # if GNUTLS_VERSION_NUMBER >= 0x030114
1439 if (verification & GNUTLS_CERT_REVOCATION_DATA_SUPERSEDED)
1440 warnings = Fcons (intern (":revocation-data-superseded"), warnings);
1441
1442 if (verification & GNUTLS_CERT_REVOCATION_DATA_ISSUED_IN_FUTURE)
1443 warnings = Fcons (intern (":revocation-data-issued-in-future"), warnings);
1444
1445 if (verification & GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE)
1446 warnings = Fcons (intern (":signer-constraints-failure"), warnings);
1447
1448 # if GNUTLS_VERSION_NUMBER >= 0x030400
1449 if (verification & GNUTLS_CERT_PURPOSE_MISMATCH)
1450 warnings = Fcons (intern (":purpose-mismatch"), warnings);
1451
1452 # if GNUTLS_VERSION_NUMBER >= 0x030501
1453 if (verification & GNUTLS_CERT_MISSING_OCSP_STATUS)
1454 warnings = Fcons (intern (":missing-ocsp-status"), warnings);
1455
1456 if (verification & GNUTLS_CERT_INVALID_OCSP_STATUS)
1457 warnings = Fcons (intern (":invalid-ocsp-status"), warnings);
1458 # endif
1459 # endif
1460 # endif
1461 # endif
1462
1463 if (XPROCESS (proc)->gnutls_extra_peer_verification &
1464 CERTIFICATE_NOT_MATCHING)
1465 warnings = Fcons (intern (":no-host-match"), warnings);
1466
1467
1468
1469 if (XPROCESS (proc)->gnutls_certificates != NULL &&
1470 gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificates[0],
1471 XPROCESS (proc)->gnutls_certificates[0]))
1472 warnings = Fcons (intern (":self-signed"), warnings);
1473
1474 if (!NILP (warnings))
1475 result = list2 (intern (":warnings"), warnings);
1476
1477
1478
1479 if (XPROCESS (proc)->gnutls_certificates != NULL)
1480 {
1481 Lisp_Object certs = Qnil;
1482
1483
1484 for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++)
1485 certs = nconc2 (certs, list1 (emacs_gnutls_certificate_details
1486 (XPROCESS (proc)->gnutls_certificates[i])));
1487
1488 result = nconc2 (result, list2 (intern (":certificates"), certs));
1489
1490
1491
1492 result = nconc2 (result, list2 (intern (":certificate"), Fcar (certs)));
1493 }
1494
1495 state = XPROCESS (proc)->gnutls_state;
1496
1497
1498 {
1499 int bits = gnutls_dh_get_prime_bits (state);
1500 check_memory_full (bits);
1501 if (bits > 0)
1502 result = nconc2 (result, list2 (intern (":diffie-hellman-prime-bits"),
1503 make_fixnum (bits)));
1504 }
1505
1506
1507 result = nconc2
1508 (result, list2 (intern (":key-exchange"),
1509 build_string (gnutls_kx_get_name
1510 (gnutls_kx_get (state)))));
1511
1512
1513 gnutls_protocol_t proto = gnutls_protocol_get_version (state);
1514 result = nconc2
1515 (result, list2 (intern (":protocol"),
1516 build_string (gnutls_protocol_get_name (proto))));
1517
1518
1519 result = nconc2
1520 (result, list2 (intern (":cipher"),
1521 build_string (gnutls_cipher_get_name
1522 (gnutls_cipher_get (state)))));
1523
1524
1525 result = nconc2
1526 (result, list2 (intern (":mac"),
1527 build_string (gnutls_mac_get_name
1528 (gnutls_mac_get (state)))));
1529
1530
1531 # ifdef HAVE_GNUTLS_COMPRESSION_GET
1532 result = nconc2
1533 (result, list2 (intern (":compression"),
1534 build_string (gnutls_compression_get_name
1535 (gnutls_compression_get (state)))));
1536 # endif
1537
1538
1539 # ifdef HAVE_GNUTLS_ETM_STATUS
1540 result = nconc2
1541 (result, list2 (intern (":encrypt-then-mac"),
1542 gnutls_session_etm_status (state) ? Qt : Qnil));
1543 # endif
1544
1545
1546 if (proto <= GNUTLS_TLS1_2)
1547 result = nconc2
1548 (result, list2 (intern (":safe-renegotiation"),
1549 gnutls_safe_renegotiation_status (state) ? Qt : Qnil));
1550
1551 return result;
1552 }
1553
1554
1555
1556
1557 static Lisp_Object
1558 emacs_gnutls_global_init (void)
1559 {
1560 int ret = GNUTLS_E_SUCCESS;
1561
1562 if (!gnutls_global_initialized)
1563 {
1564 ret = gnutls_global_init ();
1565 if (ret == GNUTLS_E_SUCCESS)
1566 gnutls_global_initialized = 1;
1567 }
1568
1569 return gnutls_make_error (ret);
1570 }
1571
1572 static bool
1573 gnutls_ip_address_p (char *string)
1574 {
1575 char c;
1576
1577 while ((c = *string++) != 0)
1578 if (! ((c == '.' || c == ':' || (c >= '0' && c <= '9'))))
1579 return false;
1580
1581 return true;
1582 }
1583
1584 # if 0
1585
1586
1587 static Lisp_Object
1588 emacs_gnutls_global_deinit (void)
1589 {
1590 if (gnutls_global_initialized)
1591 gnutls_global_deinit ();
1592
1593 gnutls_global_initialized = 0;
1594
1595 return gnutls_make_error (GNUTLS_E_SUCCESS);
1596 }
1597 # endif
1598
1599 static void ATTRIBUTE_FORMAT_PRINTF (2, 3)
1600 boot_error (struct Lisp_Process *p, const char *m, ...)
1601 {
1602 va_list ap;
1603 va_start (ap, m);
1604 if (p->is_non_blocking_client)
1605 pset_status (p, list2 (Qfailed, vformat_string (m, ap)));
1606 else
1607 verror (m, ap);
1608 va_end (ap);
1609 }
1610
1611 DEFUN ("gnutls-format-certificate", Fgnutls_format_certificate,
1612 Sgnutls_format_certificate, 1, 1, 0,
1613 doc:
1614
1615
1616 )
1617 (Lisp_Object cert)
1618 {
1619 CHECK_STRING (cert);
1620
1621 int err;
1622 gnutls_x509_crt_t crt;
1623
1624 err = gnutls_x509_crt_init (&crt);
1625 check_memory_full (err);
1626 if (err < GNUTLS_E_SUCCESS)
1627 error ("gnutls-format-certificate error: %s", emacs_gnutls_strerror (err));
1628
1629 gnutls_datum_t crt_data = { SDATA (cert), strlen (SSDATA (cert)) };
1630 err = gnutls_x509_crt_import (crt, &crt_data, GNUTLS_X509_FMT_PEM);
1631 check_memory_full (err);
1632 if (err < GNUTLS_E_SUCCESS)
1633 {
1634 gnutls_x509_crt_deinit (crt);
1635 error ("gnutls-format-certificate error: %s",
1636 emacs_gnutls_strerror (err));
1637 }
1638
1639 gnutls_datum_t out;
1640 err = gnutls_x509_crt_print (crt, GNUTLS_CRT_PRINT_FULL, &out);
1641 check_memory_full (err);
1642 if (err < GNUTLS_E_SUCCESS)
1643 {
1644 gnutls_x509_crt_deinit (crt);
1645 error ("gnutls-format-certificate error: %s",
1646 emacs_gnutls_strerror (err));
1647 }
1648
1649 Lisp_Object result = make_string_from_bytes ((char *) out.data, out.size,
1650 out.size);
1651 gnutls_free (out.data);
1652 gnutls_x509_crt_deinit (crt);
1653
1654 return result;
1655 }
1656
1657 Lisp_Object
1658 gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
1659 {
1660 int ret;
1661 struct Lisp_Process *p = XPROCESS (proc);
1662 gnutls_session_t state = p->gnutls_state;
1663 unsigned int peer_verification;
1664 Lisp_Object warnings;
1665 int max_log_level = p->gnutls_log_level;
1666 Lisp_Object hostname, verify_error;
1667 bool verify_error_all = false;
1668 char *c_hostname;
1669
1670 if (NILP (proplist))
1671 proplist = Fcdr (plist_get (p->childp, QCtls_parameters));
1672
1673 verify_error = plist_get (proplist, QCverify_error);
1674 hostname = plist_get (proplist, QChostname);
1675
1676 if (EQ (verify_error, Qt))
1677 verify_error_all = true;
1678 else if (NILP (Flistp (verify_error)))
1679 {
1680 boot_error (p,
1681 "gnutls-boot: invalid :verify_error parameter (not a list)");
1682 return Qnil;
1683 }
1684
1685 if (!STRINGP (hostname))
1686 {
1687 boot_error (p, "gnutls-boot: invalid :hostname parameter (not a string)");
1688 return Qnil;
1689 }
1690 c_hostname = SSDATA (hostname);
1691
1692
1693
1694
1695
1696
1697
1698 ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
1699 if (ret < GNUTLS_E_SUCCESS)
1700 return gnutls_make_error (ret);
1701
1702 p->gnutls_peer_verification = peer_verification;
1703
1704 warnings = plist_get (Fgnutls_peer_status (proc), intern (":warnings"));
1705 if (!NILP (warnings))
1706 {
1707 for (Lisp_Object tail = warnings; CONSP (tail); tail = XCDR (tail))
1708 {
1709 Lisp_Object warning = XCAR (tail);
1710 Lisp_Object message = Fgnutls_peer_status_warning_describe (warning);
1711 if (!NILP (message))
1712 GNUTLS_LOG2 (1, max_log_level, "verification:", SSDATA (message));
1713 }
1714 }
1715
1716 if (peer_verification != 0)
1717 {
1718 if (verify_error_all
1719 || !NILP (Fmember (QCtrustfiles, verify_error)))
1720 {
1721 emacs_gnutls_deinit (proc);
1722 boot_error (p,
1723 "Certificate validation failed %s, verification code %x",
1724 c_hostname, peer_verification);
1725 return Qnil;
1726 }
1727 else
1728 {
1729 GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
1730 c_hostname);
1731 }
1732 }
1733
1734
1735
1736
1737 if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
1738 {
1739 const gnutls_datum_t *cert_list;
1740 unsigned int cert_list_length;
1741 int failed_import = 0;
1742
1743 cert_list = gnutls_certificate_get_peers (state, &cert_list_length);
1744
1745 if (cert_list == NULL)
1746 {
1747 emacs_gnutls_deinit (proc);
1748 boot_error (p, "No x509 certificate was found\n");
1749 return Qnil;
1750 }
1751
1752
1753
1754 p->gnutls_certificates =
1755 xmalloc (cert_list_length * sizeof (gnutls_x509_crt_t));
1756 p->gnutls_certificates_length = cert_list_length;
1757
1758 for (int i = cert_list_length - 1; i >= 0; i--)
1759 {
1760 gnutls_x509_crt_t cert;
1761
1762 gnutls_x509_crt_init (&cert);
1763
1764 if (ret < GNUTLS_E_SUCCESS)
1765 failed_import = ret;
1766 else
1767 {
1768 ret = gnutls_x509_crt_import (cert, &cert_list[i],
1769 GNUTLS_X509_FMT_DER);
1770
1771 if (ret < GNUTLS_E_SUCCESS)
1772 failed_import = ret;
1773 }
1774
1775 p->gnutls_certificates[i] = cert;
1776 }
1777
1778 if (failed_import != 0)
1779 {
1780 gnutls_deinit_certificates (p);
1781 return gnutls_make_error (failed_import);
1782 }
1783
1784 int err = gnutls_x509_crt_check_hostname (p->gnutls_certificates[0],
1785 c_hostname);
1786 check_memory_full (err);
1787 if (!err)
1788 {
1789 p->gnutls_extra_peer_verification |= CERTIFICATE_NOT_MATCHING;
1790 if (verify_error_all
1791 || !NILP (Fmember (QChostname, verify_error)))
1792 {
1793 emacs_gnutls_deinit (proc);
1794 boot_error (p, "The x509 certificate does not match \"%s\"",
1795 c_hostname);
1796 return Qnil;
1797 }
1798 else
1799 GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
1800 c_hostname);
1801 }
1802 }
1803
1804
1805 p->gnutls_p = true;
1806
1807 return gnutls_make_error (ret);
1808 }
1809
1810 #ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
1811
1812
1813
1814
1815
1816
1817
1818 static unsigned int
1819 key_file2_aux (Lisp_Object flags)
1820 {
1821 unsigned int rv = 0;
1822 Lisp_Object tail = flags;
1823 FOR_EACH_TAIL_SAFE (tail)
1824 {
1825 Lisp_Object flag = XCAR (tail);
1826 if (EQ (flag, Qgnutls_pkcs_plain))
1827 rv |= GNUTLS_PKCS_PLAIN;
1828 #ifdef GNUTLS_PKCS_PKCS12_3DES
1829 else if (EQ (flag, Qgnutls_pkcs_pkcs12_3des))
1830 rv |= GNUTLS_PKCS_PKCS12_3DES;
1831 #endif
1832 #ifdef GNUTLS_PKCS_PKCS12_ARCFOUR
1833 else if (EQ (flag, Qgnutls_pkcs_pkcs12_arcfour))
1834 rv |= GNUTLS_PKCS_PKCS12_ARCFOUR;
1835 #endif
1836 #ifdef GNUTLS_PKCS_PKCS12_RC2_40
1837 else if (EQ (flag, Qgnutls_pkcs_pkcs12_rc2_40))
1838 rv |= GNUTLS_PKCS_PKCS12_RC2_40;
1839 #endif
1840 #ifdef GNUTLS_PKCS_PBES2_3DES
1841 else if (EQ (flag, Qgnutls_pkcs_pbes2_3des))
1842 rv |= GNUTLS_PKCS_PBES2_3DES;
1843 #endif
1844 #ifdef GNUTLS_PKCS_PBES2_AES_128
1845 else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_128))
1846 rv |= GNUTLS_PKCS_PBES2_AES_128;
1847 #endif
1848 #ifdef GNUTLS_PKCS_PBES2_AES_192
1849 else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_192))
1850 rv |= GNUTLS_PKCS_PBES2_AES_192;
1851 #endif
1852 #ifdef GNUTLS_PKCS_PBES2_AES_256
1853 else if (EQ (flag, Qgnutls_pkcs_pbes2_aes_256))
1854 rv |= GNUTLS_PKCS_PBES2_AES_256;
1855 #endif
1856 else if (EQ (flag, Qgnutls_pkcs_null_password))
1857 rv |= GNUTLS_PKCS_NULL_PASSWORD;
1858 #ifdef GNUTLS_PKCS_PBES2_DES
1859 else if (EQ (flag, Qgnutls_pkcs_pbes2_des))
1860 rv |= GNUTLS_PKCS_PBES2_DES;
1861 #endif
1862 #ifdef GNUTLS_PKCS_PBES1_DES_MD5
1863 else if (EQ (flag, Qgnutls_pkcs_pbes1_des_md5))
1864 rv |= GNUTLS_PKCS_PBES1_DES_MD5;
1865 #endif
1866 #ifdef GNUTLS_PKCS_PBES2_GOST_TC26Z
1867 else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_tc26z))
1868 rv |= GNUTLS_PKCS_PBES2_GOST_TC26Z;
1869 #endif
1870 #ifdef GNUTLS_PKCS_PBES2_GOST_CPA
1871 else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpa))
1872 rv |= GNUTLS_PKCS_PBES2_GOST_CPA;
1873 #endif
1874 #ifdef GNUTLS_PKCS_PBES2_GOST_CPB
1875 else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpb))
1876 rv |= GNUTLS_PKCS_PBES2_GOST_CPB;
1877 #endif
1878 #ifdef GNUTLS_PKCS_PBES2_GOST_CPC
1879 else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpc))
1880 rv |= GNUTLS_PKCS_PBES2_GOST_CPC;
1881 #endif
1882 #ifdef GNUTLS_PKCS_PBES2_GOST_CPD
1883 else if (EQ (flag, Qgnutls_pkcs_pbes2_gost_cpd))
1884 rv |= GNUTLS_PKCS_PBES2_GOST_CPD;
1885 #endif
1886 }
1887 return rv;
1888 }
1889
1890 #endif
1891
1892 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
1893 doc:
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967 )
1968 (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
1969 {
1970 int ret = GNUTLS_E_SUCCESS;
1971 int max_log_level = 0;
1972
1973 gnutls_session_t state;
1974 gnutls_certificate_credentials_t x509_cred = NULL;
1975 gnutls_anon_client_credentials_t anon_cred = NULL;
1976 Lisp_Object global_init;
1977 char const *priority_string_ptr = "NORMAL";
1978 char *c_hostname;
1979 const char *c_pass;
1980
1981
1982 Lisp_Object priority_string;
1983 Lisp_Object trustfiles;
1984 Lisp_Object crlfiles;
1985 Lisp_Object keylist;
1986 Lisp_Object pass;
1987 Lisp_Object flags;
1988
1989 Lisp_Object loglevel;
1990 Lisp_Object hostname;
1991 Lisp_Object prime_bits;
1992 #ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
1993 unsigned int aux_key_file;
1994 #endif
1995 struct Lisp_Process *p = XPROCESS (proc);
1996
1997 CHECK_PROCESS (proc);
1998 CHECK_SYMBOL (type);
1999 CHECK_LIST (proplist);
2000
2001 if (NILP (Fgnutls_available_p ()))
2002 {
2003 boot_error (p, "GnuTLS not available");
2004 return Qnil;
2005 }
2006
2007 if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
2008 {
2009 boot_error (p, "Invalid GnuTLS credential type");
2010 return Qnil;
2011 }
2012
2013 hostname = plist_get (proplist, QChostname);
2014 priority_string = plist_get (proplist, QCpriority);
2015 trustfiles = plist_get (proplist, QCtrustfiles);
2016 keylist = plist_get (proplist, QCkeylist);
2017 crlfiles = plist_get (proplist, QCcrlfiles);
2018 loglevel = plist_get (proplist, QCloglevel);
2019 prime_bits = plist_get (proplist, QCmin_prime_bits);
2020 pass = plist_get (proplist, QCpass);
2021 flags = plist_get (proplist, QCflags);
2022
2023 if (STRINGP (pass))
2024 c_pass = SSDATA (pass);
2025 else
2026 c_pass = NULL;
2027
2028 if (!STRINGP (hostname))
2029 {
2030 boot_error (p, "gnutls-boot: invalid :hostname parameter (not a string)");
2031 return Qnil;
2032 }
2033 c_hostname = SSDATA (hostname);
2034
2035 state = XPROCESS (proc)->gnutls_state;
2036
2037 if (INTEGERP (loglevel))
2038 {
2039 gnutls_global_set_log_function (gnutls_log_function);
2040 # ifdef HAVE_GNUTLS3
2041 gnutls_global_set_audit_log_function (gnutls_audit_log_function);
2042 # endif
2043 int level = (FIXNUMP (loglevel)
2044 ? clip_to_bounds (INT_MIN, XFIXNUM (loglevel), INT_MAX)
2045 : NILP (Fnatnump (loglevel)) ? INT_MIN : INT_MAX);
2046 gnutls_global_set_log_level (level);
2047 max_log_level = level;
2048 XPROCESS (proc)->gnutls_log_level = max_log_level;
2049 }
2050
2051 GNUTLS_LOG2 (1, max_log_level, "connecting to host:", c_hostname);
2052
2053
2054 global_init = emacs_gnutls_global_init ();
2055 if (! NILP (Fgnutls_errorp (global_init)))
2056 return global_init;
2057
2058
2059
2060 emacs_gnutls_deinit (proc);
2061
2062
2063 XPROCESS (proc)->gnutls_state = NULL;
2064 XPROCESS (proc)->gnutls_x509_cred = NULL;
2065 XPROCESS (proc)->gnutls_anon_cred = NULL;
2066 pset_gnutls_cred_type (XPROCESS (proc), type);
2067 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
2068
2069 GNUTLS_LOG (1, max_log_level, "allocating credentials");
2070 if (EQ (type, Qgnutls_x509pki))
2071 {
2072 Lisp_Object verify_flags;
2073 unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
2074
2075 GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
2076 check_memory_full (gnutls_certificate_allocate_credentials (&x509_cred));
2077 XPROCESS (proc)->gnutls_x509_cred = x509_cred;
2078
2079 verify_flags = plist_get (proplist, QCverify_flags);
2080 if (TYPE_RANGED_FIXNUMP (unsigned int, verify_flags))
2081 {
2082 gnutls_verify_flags = XFIXNAT (verify_flags);
2083 GNUTLS_LOG (2, max_log_level, "setting verification flags");
2084 }
2085 else if (NILP (verify_flags))
2086 GNUTLS_LOG (2, max_log_level, "using default verification flags");
2087 else
2088 GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
2089
2090 gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
2091 }
2092 else
2093 {
2094 GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
2095 check_memory_full (gnutls_anon_allocate_client_credentials (&anon_cred));
2096 XPROCESS (proc)->gnutls_anon_cred = anon_cred;
2097 }
2098
2099 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
2100
2101 if (EQ (type, Qgnutls_x509pki))
2102 {
2103
2104 int file_format = GNUTLS_X509_FMT_PEM;
2105 Lisp_Object tail;
2106
2107 # ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
2108 ret = gnutls_certificate_set_x509_system_trust (x509_cred);
2109 if (ret < GNUTLS_E_SUCCESS)
2110 {
2111 check_memory_full (ret);
2112 GNUTLS_LOG2i (4, max_log_level,
2113 "setting system trust failed with code ", ret);
2114 }
2115 # endif
2116
2117 for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
2118 {
2119 Lisp_Object trustfile = XCAR (tail);
2120 if (STRINGP (trustfile))
2121 {
2122 GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
2123 SSDATA (trustfile));
2124 trustfile = ENCODE_FILE (trustfile);
2125 # ifdef WINDOWSNT
2126
2127
2128
2129 trustfile = ansi_encode_filename (trustfile);
2130 # endif
2131 ret = gnutls_certificate_set_x509_trust_file
2132 (x509_cred,
2133 SSDATA (trustfile),
2134 file_format);
2135
2136 if (ret < GNUTLS_E_SUCCESS)
2137 return gnutls_make_error (ret);
2138 }
2139 else
2140 {
2141 emacs_gnutls_deinit (proc);
2142 boot_error (p, "Invalid trustfile");
2143 return Qnil;
2144 }
2145 }
2146
2147 for (tail = crlfiles; CONSP (tail); tail = XCDR (tail))
2148 {
2149 Lisp_Object crlfile = XCAR (tail);
2150 if (STRINGP (crlfile))
2151 {
2152 GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
2153 SSDATA (crlfile));
2154 crlfile = ENCODE_FILE (crlfile);
2155 # ifdef WINDOWSNT
2156 crlfile = ansi_encode_filename (crlfile);
2157 # endif
2158 ret = gnutls_certificate_set_x509_crl_file
2159 (x509_cred, SSDATA (crlfile), file_format);
2160
2161 if (ret < GNUTLS_E_SUCCESS)
2162 return gnutls_make_error (ret);
2163 }
2164 else
2165 {
2166 emacs_gnutls_deinit (proc);
2167 boot_error (p, "Invalid CRL file");
2168 return Qnil;
2169 }
2170 }
2171
2172 for (tail = keylist; CONSP (tail); tail = XCDR (tail))
2173 {
2174 Lisp_Object keyfile = Fcar (XCAR (tail));
2175 Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
2176 if (STRINGP (keyfile) && STRINGP (certfile))
2177 {
2178 GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
2179 SSDATA (keyfile));
2180 GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
2181 SSDATA (certfile));
2182 keyfile = ENCODE_FILE (keyfile);
2183 certfile = ENCODE_FILE (certfile);
2184 # ifdef WINDOWSNT
2185 keyfile = ansi_encode_filename (keyfile);
2186 certfile = ansi_encode_filename (certfile);
2187 # endif
2188 # ifdef HAVE_GNUTLS_CERTIFICATE_SET_X509_KEY_FILE2
2189 if (!NILP (plist_member (proplist, QCpass)))
2190 {
2191 aux_key_file = key_file2_aux (flags);
2192 ret
2193 = gnutls_certificate_set_x509_key_file2 (x509_cred,
2194 SSDATA (certfile),
2195 SSDATA (keyfile),
2196 file_format,
2197 c_pass,
2198 aux_key_file);
2199 }
2200 else
2201 # endif
2202 ret = gnutls_certificate_set_x509_key_file
2203 (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
2204
2205 if (ret < GNUTLS_E_SUCCESS)
2206 return gnutls_make_error (ret);
2207 }
2208 else
2209 {
2210 emacs_gnutls_deinit (proc);
2211 boot_error (p, STRINGP (keyfile) ? "Invalid client cert file"
2212 : "Invalid client key file");
2213 return Qnil;
2214 }
2215 }
2216 }
2217
2218 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
2219 GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
2220 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
2221
2222
2223
2224 GNUTLS_LOG (1, max_log_level, "gnutls_init");
2225 int gnutls_flags = GNUTLS_CLIENT;
2226 # ifdef GNUTLS_NONBLOCK
2227 if (XPROCESS (proc)->is_non_blocking_client)
2228 gnutls_flags |= GNUTLS_NONBLOCK;
2229 # endif
2230 ret = gnutls_init (&state, gnutls_flags);
2231 XPROCESS (proc)->gnutls_state = state;
2232 if (ret < GNUTLS_E_SUCCESS)
2233 return gnutls_make_error (ret);
2234 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
2235
2236 if (STRINGP (priority_string))
2237 {
2238 priority_string_ptr = SSDATA (priority_string);
2239 GNUTLS_LOG2 (1, max_log_level, "got non-default priority string:",
2240 priority_string_ptr);
2241 }
2242 else
2243 {
2244 GNUTLS_LOG2 (1, max_log_level, "using default priority string:",
2245 priority_string_ptr);
2246 }
2247
2248 GNUTLS_LOG (1, max_log_level, "setting the priority string");
2249 ret = gnutls_priority_set_direct (state, priority_string_ptr, NULL);
2250 if (ret < GNUTLS_E_SUCCESS)
2251 return gnutls_make_error (ret);
2252
2253 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
2254
2255 if (FIXNUMP (prime_bits))
2256 gnutls_dh_set_prime_bits (state, XUFIXNUM (prime_bits));
2257
2258 ret = EQ (type, Qgnutls_x509pki)
2259 ? gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
2260 : gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
2261 if (ret < GNUTLS_E_SUCCESS)
2262 return gnutls_make_error (ret);
2263
2264 if (!gnutls_ip_address_p (c_hostname))
2265 {
2266 ret = gnutls_server_name_set (state, GNUTLS_NAME_DNS, c_hostname,
2267 strlen (c_hostname));
2268 if (ret < GNUTLS_E_SUCCESS)
2269 return gnutls_make_error (ret);
2270 }
2271
2272 XPROCESS (proc)->gnutls_complete_negotiation_p =
2273 !NILP (plist_get (proplist, QCcomplete_negotiation));
2274 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
2275 ret = emacs_gnutls_handshake (XPROCESS (proc));
2276 if (ret < GNUTLS_E_SUCCESS)
2277 return gnutls_make_error (ret);
2278
2279 return gnutls_verify_boot (proc, proplist);
2280 }
2281
2282 DEFUN ("gnutls-bye", Fgnutls_bye,
2283 Sgnutls_bye, 2, 2, 0,
2284 doc:
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295 )
2296 (Lisp_Object proc, Lisp_Object cont)
2297 {
2298 gnutls_session_t state;
2299 int ret;
2300
2301 CHECK_PROCESS (proc);
2302
2303 state = XPROCESS (proc)->gnutls_state;
2304
2305 if (XPROCESS (proc)->gnutls_certificates)
2306 gnutls_deinit_certificates (XPROCESS (proc));
2307
2308 ret = gnutls_bye (state, NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
2309
2310 return gnutls_make_error (ret);
2311 }
2312
2313 #endif
2314
2315 #ifdef HAVE_GNUTLS3
2316
2317 # ifndef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
2318
2319 # define gnutls_cipher_get_iv_size(cipher) gnutls_cipher_get_block_size (cipher)
2320 # endif
2321
2322 # ifndef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
2323
2324 # define gnutls_cipher_get_tag_size(cipher) 0
2325 # endif
2326
2327 # ifndef HAVE_GNUTLS_DIGEST_LIST
2328
2329 # define gnutls_digest_list() \
2330 ((gnutls_digest_algorithm_t const *) gnutls_mac_list ())
2331 # define gnutls_digest_get_name(id) \
2332 gnutls_mac_get_name ((gnutls_mac_algorithm_t) (id))
2333 # endif
2334
2335 DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0,
2336 doc:
2337 )
2338 (void)
2339 {
2340 Lisp_Object ciphers = Qnil;
2341
2342 const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list ();
2343 for (ptrdiff_t pos = 0; gciphers[pos] != 0; pos++)
2344 {
2345 gnutls_cipher_algorithm_t gca = gciphers[pos];
2346 if (gca == GNUTLS_CIPHER_NULL)
2347 continue;
2348 char const *cipher_name = gnutls_cipher_get_name (gca);
2349 if (!cipher_name)
2350 continue;
2351
2352
2353 Lisp_Object cipher_symbol = intern (cipher_name);
2354
2355 ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca);
2356
2357 Lisp_Object cp
2358 = list (cipher_symbol,
2359 QCcipher_id, make_fixnum (gca),
2360 QCtype, Qgnutls_type_cipher,
2361 QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt,
2362 QCcipher_tagsize, make_fixnum (cipher_tag_size),
2363
2364 QCcipher_blocksize,
2365 make_fixnum (gnutls_cipher_get_block_size (gca)),
2366
2367 QCcipher_keysize,
2368 make_fixnum (gnutls_cipher_get_key_size (gca)),
2369
2370 QCcipher_ivsize,
2371 make_fixnum (gnutls_cipher_get_iv_size (gca)));
2372
2373 ciphers = Fcons (cp, ciphers);
2374 }
2375
2376 return ciphers;
2377 }
2378
2379 static Lisp_Object
2380 gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca,
2381 Lisp_Object cipher,
2382 const char *kdata, ptrdiff_t ksize,
2383 const char *vdata, ptrdiff_t vsize,
2384 const char *idata, ptrdiff_t isize,
2385 Lisp_Object aead_auth)
2386 {
2387 # ifdef HAVE_GNUTLS_AEAD
2388
2389 const char *desc = encrypting ? "encrypt" : "decrypt";
2390 Lisp_Object actual_iv = make_unibyte_string (vdata, vsize);
2391
2392 gnutls_aead_cipher_hd_t acipher;
2393 gnutls_datum_t key_datum = { (unsigned char *) kdata, ksize };
2394 int ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum);
2395
2396 if (ret < GNUTLS_E_SUCCESS)
2397 error ("GnuTLS AEAD cipher %s/%s initialization failed: %s",
2398 gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret));
2399
2400 ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca);
2401 ptrdiff_t tagged_size;
2402 if (ckd_add (&tagged_size, isize, cipher_tag_size)
2403 || SIZE_MAX < tagged_size)
2404 memory_full (SIZE_MAX);
2405 size_t storage_length = tagged_size;
2406 USE_SAFE_ALLOCA;
2407 char *storage = SAFE_ALLOCA (storage_length);
2408
2409 const char *aead_auth_data = NULL;
2410 ptrdiff_t aead_auth_size = 0;
2411
2412 if (!NILP (aead_auth))
2413 {
2414 if (BUFFERP (aead_auth) || STRINGP (aead_auth))
2415 aead_auth = list1 (aead_auth);
2416
2417 CHECK_CONS (aead_auth);
2418
2419 ptrdiff_t astart_byte, aend_byte;
2420 const char *adata
2421 = extract_data_from_object (aead_auth, &astart_byte, &aend_byte);
2422 if (adata == NULL)
2423 error ("GnuTLS AEAD cipher auth extraction failed");
2424
2425 aead_auth_data = adata;
2426 aead_auth_size = aend_byte - astart_byte;
2427 }
2428
2429
2430
2431 #if 0
2432 ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size;
2433 ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
2434
2435 if (isize < expected_remainder
2436 || (isize - expected_remainder) % cipher_block_size != 0)
2437 error (("GnuTLS AEAD cipher %s/%s input block length %"pD"d "
2438 "is not %"pD"d greater than a multiple of the required %"pD"d"),
2439 gnutls_cipher_get_name (gca), desc,
2440 isize, expected_remainder, cipher_block_size);
2441 #endif
2442
2443 ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt)
2444 (acipher, vdata, vsize, aead_auth_data, aead_auth_size,
2445 cipher_tag_size, idata, isize, storage, &storage_length));
2446
2447 Lisp_Object output;
2448 if (GNUTLS_E_SUCCESS <= ret)
2449 output = make_unibyte_string (storage, storage_length);
2450 memset_explicit (storage, 0, storage_length);
2451 gnutls_aead_cipher_deinit (acipher);
2452
2453 if (ret < GNUTLS_E_SUCCESS)
2454 error ((encrypting
2455 ? "GnuTLS AEAD cipher %s encryption failed: %s"
2456 : "GnuTLS AEAD cipher %s decryption failed: %s"),
2457 gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
2458
2459 SAFE_FREE ();
2460 return list2 (output, actual_iv);
2461 # else
2462 intmax_t print_gca = gca;
2463 error ("GnuTLS AEAD cipher %"PRIdMAX" is invalid or not found", print_gca);
2464 # endif
2465 }
2466
2467 static Lisp_Object cipher_cache;
2468
2469 static Lisp_Object
2470 gnutls_symmetric (bool encrypting, Lisp_Object cipher,
2471 Lisp_Object key, Lisp_Object iv,
2472 Lisp_Object input, Lisp_Object aead_auth)
2473 {
2474 if (BUFFERP (key) || STRINGP (key))
2475 key = list1 (key);
2476
2477 CHECK_CONS (key);
2478
2479 if (BUFFERP (input) || STRINGP (input))
2480 input = list1 (input);
2481
2482 CHECK_CONS (input);
2483
2484 if (BUFFERP (iv) || STRINGP (iv))
2485 iv = list1 (iv);
2486
2487 CHECK_CONS (iv);
2488
2489
2490 const char *desc = encrypting ? "encrypt" : "decrypt";
2491
2492 gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN;
2493
2494 Lisp_Object info = Qnil;
2495 if (STRINGP (cipher))
2496 cipher = intern (SSDATA (cipher));
2497
2498 if (SYMBOLP (cipher))
2499 {
2500 if (NILP (cipher_cache))
2501 cipher_cache = Fgnutls_ciphers ();
2502 info = Fassq (cipher, cipher_cache);
2503 if (!CONSP (info))
2504 xsignal2 (Qerror,
2505 build_string ("GnuTLS cipher is invalid or not found"),
2506 cipher);
2507 info = XCDR (info);
2508 }
2509 else if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, cipher))
2510 gca = XFIXNUM (cipher);
2511 else
2512 info = cipher;
2513
2514 if (!NILP (info) && CONSP (info))
2515 {
2516 Lisp_Object v = plist_get (info, QCcipher_id);
2517 if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, v))
2518 gca = XFIXNUM (v);
2519 }
2520
2521 ptrdiff_t key_size = gnutls_cipher_get_key_size (gca);
2522 if (key_size == 0)
2523 xsignal2 (Qerror,
2524 build_string ("GnuTLS cipher is invalid or not found"), cipher);
2525
2526 ptrdiff_t kstart_byte, kend_byte;
2527 const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
2528
2529 if (kdata == NULL)
2530 error ("GnuTLS cipher key extraction failed");
2531
2532 if (kend_byte - kstart_byte != key_size)
2533 error (("GnuTLS cipher %s/%s key length %"pD"d is not equal to "
2534 "the required %"pD"d"),
2535 gnutls_cipher_get_name (gca), desc,
2536 kend_byte - kstart_byte, key_size);
2537
2538 ptrdiff_t vstart_byte, vend_byte;
2539 char *vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte);
2540
2541 if (vdata == NULL)
2542 error ("GnuTLS cipher IV extraction failed");
2543
2544 ptrdiff_t iv_size = gnutls_cipher_get_iv_size (gca);
2545 if (vend_byte - vstart_byte != iv_size)
2546 error (("GnuTLS cipher %s/%s IV length %"pD"d is not equal to "
2547 "the required %"pD"d"),
2548 gnutls_cipher_get_name (gca), desc,
2549 vend_byte - vstart_byte, iv_size);
2550
2551 Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte);
2552
2553 ptrdiff_t istart_byte, iend_byte;
2554 const char *idata
2555 = extract_data_from_object (input, &istart_byte, &iend_byte);
2556
2557 if (idata == NULL)
2558 error ("GnuTLS cipher input extraction failed");
2559
2560
2561 if (gnutls_cipher_get_tag_size (gca) > 0)
2562 {
2563 Lisp_Object aead_output =
2564 gnutls_symmetric_aead (encrypting, gca, cipher,
2565 kdata, kend_byte - kstart_byte,
2566 vdata, vend_byte - vstart_byte,
2567 idata, iend_byte - istart_byte,
2568 aead_auth);
2569 if (STRINGP (XCAR (key)))
2570 Fclear_string (XCAR (key));
2571 return aead_output;
2572 }
2573
2574 ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
2575 if ((iend_byte - istart_byte) % cipher_block_size != 0)
2576 error (("GnuTLS cipher %s/%s input block length %"pD"d is not a multiple "
2577 "of the required %"pD"d"),
2578 gnutls_cipher_get_name (gca), desc,
2579 iend_byte - istart_byte, cipher_block_size);
2580
2581 gnutls_cipher_hd_t hcipher;
2582 gnutls_datum_t key_datum
2583 = { (unsigned char *) kdata, kend_byte - kstart_byte };
2584
2585 int ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL);
2586
2587 if (ret < GNUTLS_E_SUCCESS)
2588 error ("GnuTLS cipher %s/%s initialization failed: %s",
2589 gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret));
2590
2591
2592 gnutls_cipher_set_iv (hcipher, vdata, vend_byte - vstart_byte);
2593
2594
2595
2596 ptrdiff_t storage_length = iend_byte - istart_byte;
2597 Lisp_Object storage = make_uninit_string (storage_length);
2598
2599 ret = ((encrypting ? gnutls_cipher_encrypt2 : gnutls_cipher_decrypt2)
2600 (hcipher, idata, iend_byte - istart_byte,
2601 SSDATA (storage), storage_length));
2602
2603 if (STRINGP (XCAR (key)))
2604 Fclear_string (XCAR (key));
2605
2606 if (ret < GNUTLS_E_SUCCESS)
2607 {
2608 gnutls_cipher_deinit (hcipher);
2609 if (encrypting)
2610 error ("GnuTLS cipher %s encryption failed: %s",
2611 gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
2612 else
2613 error ("GnuTLS cipher %s decryption failed: %s",
2614 gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
2615 }
2616
2617 gnutls_cipher_deinit (hcipher);
2618
2619 return list2 (storage, actual_iv);
2620 }
2621
2622 DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt,
2623 Sgnutls_symmetric_encrypt, 4, 5, 0,
2624 doc:
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641 )
2642 (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv,
2643 Lisp_Object input, Lisp_Object aead_auth)
2644 {
2645 return gnutls_symmetric (true, cipher, key, iv, input, aead_auth);
2646 }
2647
2648 DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt,
2649 Sgnutls_symmetric_decrypt, 4, 5, 0,
2650 doc:
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667 )
2668 (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv,
2669 Lisp_Object input, Lisp_Object aead_auth)
2670 {
2671 return gnutls_symmetric (false, cipher, key, iv, input, aead_auth);
2672 }
2673
2674 DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0,
2675 doc:
2676
2677
2678
2679 )
2680 (void)
2681 {
2682 Lisp_Object mac_algorithms = Qnil;
2683 const gnutls_mac_algorithm_t *macs = gnutls_mac_list ();
2684 for (ptrdiff_t pos = 0; macs[pos] != 0; pos++)
2685 {
2686 const gnutls_mac_algorithm_t gma = macs[pos];
2687
2688
2689 Lisp_Object gma_symbol = intern (gnutls_mac_get_name (gma));
2690
2691 size_t nonce_size = 0;
2692 # ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
2693 nonce_size = gnutls_mac_get_nonce_size (gma);
2694 # endif
2695 Lisp_Object mp = list (gma_symbol,
2696 QCmac_algorithm_id, make_fixnum (gma),
2697 QCtype, Qgnutls_type_mac_algorithm,
2698
2699 QCmac_algorithm_length,
2700 make_fixnum (gnutls_hmac_get_len (gma)),
2701
2702 QCmac_algorithm_keysize,
2703 make_fixnum (gnutls_mac_get_key_size (gma)),
2704
2705 QCmac_algorithm_noncesize,
2706 make_fixnum (nonce_size));
2707 mac_algorithms = Fcons (mp, mac_algorithms);
2708 }
2709
2710 return mac_algorithms;
2711 }
2712
2713 DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0,
2714 doc:
2715
2716
2717
2718 )
2719 (void)
2720 {
2721 Lisp_Object digest_algorithms = Qnil;
2722 const gnutls_digest_algorithm_t *digests = gnutls_digest_list ();
2723 for (ptrdiff_t pos = 0; digests[pos] != 0; pos++)
2724 {
2725 const gnutls_digest_algorithm_t gda = digests[pos];
2726
2727
2728 Lisp_Object gda_symbol = intern (gnutls_digest_get_name (gda));
2729
2730 Lisp_Object mp = list (gda_symbol,
2731 QCdigest_algorithm_id, make_fixnum (gda),
2732 QCtype, Qgnutls_type_digest_algorithm,
2733
2734 QCdigest_algorithm_length,
2735 make_fixnum (gnutls_hash_get_len (gda)));
2736
2737 digest_algorithms = Fcons (mp, digest_algorithms);
2738 }
2739
2740 return digest_algorithms;
2741 }
2742
2743 DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0,
2744 doc:
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758 )
2759 (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input)
2760 {
2761 if (BUFFERP (input) || STRINGP (input))
2762 input = list1 (input);
2763
2764 CHECK_CONS (input);
2765
2766 if (BUFFERP (key) || STRINGP (key))
2767 key = list1 (key);
2768
2769 CHECK_CONS (key);
2770
2771 gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN;
2772
2773 Lisp_Object info = Qnil;
2774 if (STRINGP (hash_method))
2775 hash_method = intern (SSDATA (hash_method));
2776
2777 if (SYMBOLP (hash_method))
2778 {
2779 info = Fassq (hash_method, Fgnutls_macs ());
2780 if (!CONSP (info))
2781 xsignal2 (Qerror,
2782 build_string ("GnuTLS MAC-method is invalid or not found"),
2783 hash_method);
2784 info = XCDR (info);
2785 }
2786 else if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, hash_method))
2787 gma = XFIXNUM (hash_method);
2788 else
2789 info = hash_method;
2790
2791 if (!NILP (info) && CONSP (info))
2792 {
2793 Lisp_Object v = plist_get (info, QCmac_algorithm_id);
2794 if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, v))
2795 gma = XFIXNUM (v);
2796 }
2797
2798 ptrdiff_t digest_length = gnutls_hmac_get_len (gma);
2799 if (digest_length == 0)
2800 xsignal2 (Qerror,
2801 build_string ("GnuTLS MAC-method is invalid or not found"),
2802 hash_method);
2803
2804 ptrdiff_t kstart_byte, kend_byte;
2805 const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
2806 if (kdata == NULL)
2807 error ("GnuTLS MAC key extraction failed");
2808
2809 gnutls_hmac_hd_t hmac;
2810 int ret = gnutls_hmac_init (&hmac, gma,
2811 kdata + kstart_byte, kend_byte - kstart_byte);
2812 if (ret < GNUTLS_E_SUCCESS)
2813 error ("GnuTLS MAC %s initialization failed: %s",
2814 gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret));
2815
2816 ptrdiff_t istart_byte, iend_byte;
2817 const char *idata
2818 = extract_data_from_object (input, &istart_byte, &iend_byte);
2819 if (idata == NULL)
2820 error ("GnuTLS MAC input extraction failed");
2821
2822 Lisp_Object digest = make_uninit_string (digest_length);
2823
2824 ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte);
2825
2826 if (STRINGP (XCAR (key)))
2827 Fclear_string (XCAR (key));
2828
2829 if (ret < GNUTLS_E_SUCCESS)
2830 {
2831 gnutls_hmac_deinit (hmac, NULL);
2832 error ("GnuTLS MAC %s application failed: %s",
2833 gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret));
2834 }
2835
2836 gnutls_hmac_output (hmac, SSDATA (digest));
2837 gnutls_hmac_deinit (hmac, NULL);
2838
2839 return digest;
2840 }
2841
2842 DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0,
2843 doc:
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853 )
2854 (Lisp_Object digest_method, Lisp_Object input)
2855 {
2856 if (BUFFERP (input) || STRINGP (input))
2857 input = list1 (input);
2858
2859 CHECK_CONS (input);
2860
2861 gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN;
2862
2863 Lisp_Object info = Qnil;
2864 if (STRINGP (digest_method))
2865 digest_method = intern (SSDATA (digest_method));
2866
2867 if (SYMBOLP (digest_method))
2868 {
2869 info = Fassq (digest_method, Fgnutls_digests ());
2870 if (!CONSP (info))
2871 xsignal2 (Qerror,
2872 build_string ("GnuTLS digest-method is invalid or not found"),
2873 digest_method);
2874 info = XCDR (info);
2875 }
2876 else if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, digest_method))
2877 gda = XFIXNUM (digest_method);
2878 else
2879 info = digest_method;
2880
2881 if (!NILP (info) && CONSP (info))
2882 {
2883 Lisp_Object v = plist_get (info, QCdigest_algorithm_id);
2884 if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, v))
2885 gda = XFIXNUM (v);
2886 }
2887
2888 ptrdiff_t digest_length = gnutls_hash_get_len (gda);
2889 if (digest_length == 0)
2890 xsignal2 (Qerror,
2891 build_string ("GnuTLS digest-method is invalid or not found"),
2892 digest_method);
2893
2894 gnutls_hash_hd_t hash;
2895 int ret = gnutls_hash_init (&hash, gda);
2896
2897 if (ret < GNUTLS_E_SUCCESS)
2898 error ("GnuTLS digest initialization failed: %s",
2899 emacs_gnutls_strerror (ret));
2900
2901 Lisp_Object digest = make_uninit_string (digest_length);
2902
2903 ptrdiff_t istart_byte, iend_byte;
2904 const char *idata
2905 = extract_data_from_object (input, &istart_byte, &iend_byte);
2906 if (idata == NULL)
2907 error ("GnuTLS digest input extraction failed");
2908
2909 ret = gnutls_hash (hash, idata + istart_byte, iend_byte - istart_byte);
2910
2911 if (ret < GNUTLS_E_SUCCESS)
2912 {
2913 gnutls_hash_deinit (hash, NULL);
2914 error ("GnuTLS digest application failed: %s",
2915 emacs_gnutls_strerror (ret));
2916 }
2917
2918 gnutls_hash_output (hash, SSDATA (digest));
2919 gnutls_hash_deinit (hash, NULL);
2920
2921 return digest;
2922 }
2923
2924 #endif
2925
2926 DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
2927 doc:
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937 )
2938 (void)
2939 {
2940 Lisp_Object capabilities = Qnil;
2941
2942 #ifdef HAVE_GNUTLS
2943
2944 # ifdef WINDOWSNT
2945 Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
2946 if (CONSP (found))
2947 return XCDR (found);
2948
2949
2950
2951
2952 if (!init_gnutls_functions ())
2953 return Qnil;
2954 # endif
2955
2956 capabilities = Fcons (intern("gnutls"), capabilities);
2957
2958 # ifdef HAVE_GNUTLS_EXT__DUMBFW
2959 capabilities = Fcons (intern("ClientHello Padding"), capabilities);
2960 # endif
2961
2962 # ifdef HAVE_GNUTLS3
2963 capabilities = Fcons (intern("gnutls3"), capabilities);
2964 capabilities = Fcons (intern("digests"), capabilities);
2965 capabilities = Fcons (intern("ciphers"), capabilities);
2966
2967 # ifdef HAVE_GNUTLS_AEAD
2968 capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
2969 # endif
2970
2971 capabilities = Fcons (intern("macs"), capabilities);
2972
2973 # ifdef HAVE_GNUTLS_EXT_GET_NAME
2974 for (unsigned int ext=0; ext < 100; ext++)
2975 {
2976 const char* name = gnutls_ext_get_name(ext);
2977 if (name != NULL)
2978 {
2979 Lisp_Object cap = intern (name);
2980 if (NILP (Fmemq (cap, capabilities)))
2981 capabilities = Fcons (cap, capabilities);
2982 }
2983 }
2984 # endif
2985 # endif
2986
2987 # ifdef WINDOWSNT
2988 Vlibrary_cache = Fcons (Fcons (Qgnutls, capabilities), Vlibrary_cache);
2989 # endif
2990 #endif
2991
2992 return capabilities;
2993 }
2994
2995 void
2996 syms_of_gnutls (void)
2997 {
2998 DEFVAR_LISP ("libgnutls-version", Vlibgnutls_version,
2999 doc:
3000
3001
3002 );
3003 Vlibgnutls_version = make_fixnum
3004 #ifdef HAVE_GNUTLS
3005 (GNUTLS_VERSION_MAJOR * 10000
3006 + GNUTLS_VERSION_MINOR * 100
3007 + GNUTLS_VERSION_PATCH)
3008 #else
3009 (-1)
3010 #endif
3011 ;
3012
3013 #ifdef HAVE_GNUTLS
3014 gnutls_global_initialized = 0;
3015 PDUMPER_IGNORE (gnutls_global_initialized);
3016
3017 DEFSYM (Qgnutls_code, "gnutls-code");
3018 DEFSYM (Qgnutls_anon, "gnutls-anon");
3019 DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
3020
3021
3022 DEFSYM (QChostname, ":hostname");
3023 DEFSYM (QCpriority, ":priority");
3024 DEFSYM (QCtrustfiles, ":trustfiles");
3025 DEFSYM (QCkeylist, ":keylist");
3026 DEFSYM (QCcrlfiles, ":crlfiles");
3027 DEFSYM (QCmin_prime_bits, ":min-prime-bits");
3028 DEFSYM (QCloglevel, ":loglevel");
3029 DEFSYM (QCcomplete_negotiation, ":complete-negotiation");
3030 DEFSYM (QCpass, ":pass");
3031 DEFSYM (QCflags, ":flags");
3032 DEFSYM (QCverify_flags, ":verify-flags");
3033 DEFSYM (QCverify_error, ":verify-error");
3034 DEFSYM (Qgnutls_pkcs_plain, "GNUTLS_PKCS_PLAIN");
3035 DEFSYM (Qgnutls_pkcs_pkcs12_3des, "GNUTLS_PKCS_PKCS12_3DES");
3036 DEFSYM (Qgnutls_pkcs_pkcs12_arcfour, "GNUTLS_PKCS_PKCS12_ARCFOUR");
3037 DEFSYM (Qgnutls_pkcs_pkcs12_rc2_40, "GNUTLS_PKCS_PKCS12_RC2_40");
3038 DEFSYM (Qgnutls_pkcs_pbes2_3des, "GNUTLS_PKCS_PBES2_3DES");
3039 DEFSYM (Qgnutls_pkcs_pbes2_aes_128, "GNUTLS_PKCS_PBES2_AES_128");
3040 DEFSYM (Qgnutls_pkcs_pbes2_aes_192, "GNUTLS_PKCS_PBES2_AES_192");
3041 DEFSYM (Qgnutls_pkcs_pbes2_aes_256, "GNUTLS_PKCS_PBES2_AES_256");
3042 DEFSYM (Qgnutls_pkcs_null_password, "GNUTLS_PKCS_NULL_PASSWORD");
3043 DEFSYM (Qgnutls_pkcs_pbes2_des, "GNUTLS_PKCS_PBES2_DES");
3044 DEFSYM (Qgnutls_pkcs_pbes1_des_md5, "GNUTLS_PKCS_PBES1_DES_MD5");
3045 DEFSYM (Qgnutls_pkcs_pbes2_gost_tc26z, "GNUTLS_PKCS_PBES2_GOST_TC26Z");
3046 DEFSYM (Qgnutls_pkcs_pbes2_gost_cpa, "GNUTLS_PKCS_PBES2_GOST_CPA");
3047 DEFSYM (Qgnutls_pkcs_pbes2_gost_cpb, "GNUTLS_PKCS_PBES2_GOST_CPB");
3048 DEFSYM (Qgnutls_pkcs_pbes2_gost_cpc, "GNUTLS_PKCS_PBES2_GOST_CPC");
3049 DEFSYM (Qgnutls_pkcs_pbes2_gost_cpd, "GNUTLS_PKCS_PBES2_GOST_CPD");
3050
3051 DEFSYM (QCcipher_id, ":cipher-id");
3052 DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable");
3053 DEFSYM (QCcipher_blocksize, ":cipher-blocksize");
3054 DEFSYM (QCcipher_keysize, ":cipher-keysize");
3055 DEFSYM (QCcipher_tagsize, ":cipher-tagsize");
3056 DEFSYM (QCcipher_ivsize, ":cipher-ivsize");
3057
3058 DEFSYM (QCmac_algorithm_id, ":mac-algorithm-id");
3059 DEFSYM (QCmac_algorithm_noncesize, ":mac-algorithm-noncesize");
3060 DEFSYM (QCmac_algorithm_keysize, ":mac-algorithm-keysize");
3061 DEFSYM (QCmac_algorithm_length, ":mac-algorithm-length");
3062
3063 DEFSYM (QCdigest_algorithm_id, ":digest-algorithm-id");
3064 DEFSYM (QCdigest_algorithm_length, ":digest-algorithm-length");
3065
3066 DEFSYM (QCtype, ":type");
3067 DEFSYM (Qgnutls_type_cipher, "gnutls-symmetric-cipher");
3068 DEFSYM (Qgnutls_type_mac_algorithm, "gnutls-mac-algorithm");
3069 DEFSYM (Qgnutls_type_digest_algorithm, "gnutls-digest-algorithm");
3070
3071 DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
3072 Fput (Qgnutls_e_interrupted, Qgnutls_code,
3073 make_fixnum (GNUTLS_E_INTERRUPTED));
3074
3075 DEFSYM (Qgnutls_e_again, "gnutls-e-again");
3076 Fput (Qgnutls_e_again, Qgnutls_code,
3077 make_fixnum (GNUTLS_E_AGAIN));
3078
3079 DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session");
3080 Fput (Qgnutls_e_invalid_session, Qgnutls_code,
3081 make_fixnum (GNUTLS_E_INVALID_SESSION));
3082
3083 DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake");
3084 Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code,
3085 make_fixnum (GNUTLS_E_APPLICATION_ERROR_MIN));
3086
3087 defsubr (&Sgnutls_get_initstage);
3088 defsubr (&Sgnutls_asynchronous_parameters);
3089 defsubr (&Sgnutls_errorp);
3090 defsubr (&Sgnutls_error_fatalp);
3091 defsubr (&Sgnutls_error_string);
3092 defsubr (&Sgnutls_boot);
3093 defsubr (&Sgnutls_deinit);
3094 defsubr (&Sgnutls_bye);
3095 defsubr (&Sgnutls_peer_status);
3096 defsubr (&Sgnutls_peer_status_warning_describe);
3097 defsubr (&Sgnutls_format_certificate);
3098
3099 #ifdef HAVE_GNUTLS3
3100 defsubr (&Sgnutls_ciphers);
3101 defsubr (&Sgnutls_macs);
3102 defsubr (&Sgnutls_digests);
3103 defsubr (&Sgnutls_hash_mac);
3104 defsubr (&Sgnutls_hash_digest);
3105 defsubr (&Sgnutls_symmetric_encrypt);
3106 defsubr (&Sgnutls_symmetric_decrypt);
3107
3108 cipher_cache = Qnil;
3109 staticpro (&cipher_cache);
3110 #endif
3111
3112 DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
3113 doc:
3114
3115
3116 );
3117 global_gnutls_log_level = 0;
3118
3119 #endif
3120
3121 defsubr (&Sgnutls_available_p);
3122 }