Update copyright year to 2014 by running admin/update-copyright.
[emacs.git] / src / gnutls.c
blobdd975b160cd1c4629a730f675b5c562ddc117670
1 /* GnuTLS glue for GNU Emacs.
2 Copyright (C) 2010-2014 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19 #include <config.h>
20 #include <errno.h>
22 #include "lisp.h"
23 #include "process.h"
24 #include "coding.h"
26 #ifdef HAVE_GNUTLS
27 #include <gnutls/gnutls.h>
29 #ifdef WINDOWSNT
30 #include <windows.h>
31 #include "w32.h"
32 #endif
34 static bool emacs_gnutls_handle_error (gnutls_session_t, int);
36 static Lisp_Object Qgnutls_dll;
37 static Lisp_Object Qgnutls_code;
38 static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
39 static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
40 Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
41 static bool gnutls_global_initialized;
43 /* The following are for the property list of `gnutls-boot'. */
44 static Lisp_Object QCgnutls_bootprop_priority;
45 static Lisp_Object QCgnutls_bootprop_trustfiles;
46 static Lisp_Object QCgnutls_bootprop_keylist;
47 static Lisp_Object QCgnutls_bootprop_crlfiles;
48 static Lisp_Object QCgnutls_bootprop_callbacks;
49 static Lisp_Object QCgnutls_bootprop_loglevel;
50 static Lisp_Object QCgnutls_bootprop_hostname;
51 static Lisp_Object QCgnutls_bootprop_min_prime_bits;
52 static Lisp_Object QCgnutls_bootprop_verify_flags;
53 static Lisp_Object QCgnutls_bootprop_verify_error;
55 /* Callback keys for `gnutls-boot'. Unused currently. */
56 static Lisp_Object QCgnutls_bootprop_callbacks_verify;
58 static void gnutls_log_function (int, const char *);
59 static void gnutls_log_function2 (int, const char*, const char*);
60 #ifdef HAVE_GNUTLS3
61 static void gnutls_audit_log_function (gnutls_session_t, const char *);
62 #endif
65 #ifdef WINDOWSNT
67 /* Macro for defining functions that will be loaded from the GnuTLS DLL. */
68 #define DEF_GNUTLS_FN(rettype,func,args) static rettype (FAR CDECL *fn_##func)args
70 /* Macro for loading GnuTLS functions from the library. */
71 #define LOAD_GNUTLS_FN(lib,func) { \
72 fn_##func = (void *) GetProcAddress (lib, #func); \
73 if (!fn_##func) return 0; \
76 DEF_GNUTLS_FN (gnutls_alert_description_t, gnutls_alert_get,
77 (gnutls_session_t));
78 DEF_GNUTLS_FN (const char *, gnutls_alert_get_name,
79 (gnutls_alert_description_t));
80 DEF_GNUTLS_FN (int, gnutls_alert_send_appropriate, (gnutls_session_t, int));
81 DEF_GNUTLS_FN (int, gnutls_anon_allocate_client_credentials,
82 (gnutls_anon_client_credentials_t *));
83 DEF_GNUTLS_FN (void, gnutls_anon_free_client_credentials,
84 (gnutls_anon_client_credentials_t));
85 DEF_GNUTLS_FN (int, gnutls_bye, (gnutls_session_t, gnutls_close_request_t));
86 DEF_GNUTLS_FN (int, gnutls_certificate_allocate_credentials,
87 (gnutls_certificate_credentials_t *));
88 DEF_GNUTLS_FN (void, gnutls_certificate_free_credentials,
89 (gnutls_certificate_credentials_t));
90 DEF_GNUTLS_FN (const gnutls_datum_t *, gnutls_certificate_get_peers,
91 (gnutls_session_t, unsigned int *));
92 DEF_GNUTLS_FN (void, gnutls_certificate_set_verify_flags,
93 (gnutls_certificate_credentials_t, unsigned int));
94 DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_crl_file,
95 (gnutls_certificate_credentials_t, const char *,
96 gnutls_x509_crt_fmt_t));
97 DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_key_file,
98 (gnutls_certificate_credentials_t, const char *, const char *,
99 gnutls_x509_crt_fmt_t));
100 DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_trust_file,
101 (gnutls_certificate_credentials_t, const char *,
102 gnutls_x509_crt_fmt_t));
103 DEF_GNUTLS_FN (gnutls_certificate_type_t, gnutls_certificate_type_get,
104 (gnutls_session_t));
105 DEF_GNUTLS_FN (int, gnutls_certificate_verify_peers2,
106 (gnutls_session_t, unsigned int *));
107 DEF_GNUTLS_FN (int, gnutls_credentials_set,
108 (gnutls_session_t, gnutls_credentials_type_t, void *));
109 DEF_GNUTLS_FN (void, gnutls_deinit, (gnutls_session_t));
110 DEF_GNUTLS_FN (void, gnutls_dh_set_prime_bits,
111 (gnutls_session_t, unsigned int));
112 DEF_GNUTLS_FN (int, gnutls_error_is_fatal, (int));
113 DEF_GNUTLS_FN (int, gnutls_global_init, (void));
114 DEF_GNUTLS_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
115 #ifdef HAVE_GNUTLS3
116 DEF_GNUTLS_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func));
117 #endif
118 DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
119 DEF_GNUTLS_FN (void, gnutls_global_set_mem_functions,
120 (gnutls_alloc_function, gnutls_alloc_function,
121 gnutls_is_secure_function, gnutls_realloc_function,
122 gnutls_free_function));
123 DEF_GNUTLS_FN (int, gnutls_handshake, (gnutls_session_t));
124 DEF_GNUTLS_FN (int, gnutls_init, (gnutls_session_t *, gnutls_connection_end_t));
125 DEF_GNUTLS_FN (int, gnutls_priority_set_direct,
126 (gnutls_session_t, const char *, const char **));
127 DEF_GNUTLS_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
128 DEF_GNUTLS_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
129 DEF_GNUTLS_FN (ssize_t, gnutls_record_send,
130 (gnutls_session_t, const void *, size_t));
131 DEF_GNUTLS_FN (const char *, gnutls_strerror, (int));
132 DEF_GNUTLS_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
133 DEF_GNUTLS_FN (const char *, gnutls_check_version, (const char *));
134 DEF_GNUTLS_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
135 DEF_GNUTLS_FN (void, gnutls_transport_set_ptr2,
136 (gnutls_session_t, gnutls_transport_ptr_t,
137 gnutls_transport_ptr_t));
138 DEF_GNUTLS_FN (void, gnutls_transport_set_pull_function,
139 (gnutls_session_t, gnutls_pull_func));
140 DEF_GNUTLS_FN (void, gnutls_transport_set_push_function,
141 (gnutls_session_t, gnutls_push_func));
142 DEF_GNUTLS_FN (int, gnutls_x509_crt_check_hostname,
143 (gnutls_x509_crt_t, const char *));
144 DEF_GNUTLS_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
145 DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
146 (gnutls_x509_crt_t, const gnutls_datum_t *,
147 gnutls_x509_crt_fmt_t));
148 DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
150 static bool
151 init_gnutls_functions (void)
153 HMODULE library;
154 int max_log_level = 1;
156 if (!(library = w32_delayed_load (Qgnutls_dll)))
158 GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
159 return 0;
162 LOAD_GNUTLS_FN (library, gnutls_alert_get);
163 LOAD_GNUTLS_FN (library, gnutls_alert_get_name);
164 LOAD_GNUTLS_FN (library, gnutls_alert_send_appropriate);
165 LOAD_GNUTLS_FN (library, gnutls_anon_allocate_client_credentials);
166 LOAD_GNUTLS_FN (library, gnutls_anon_free_client_credentials);
167 LOAD_GNUTLS_FN (library, gnutls_bye);
168 LOAD_GNUTLS_FN (library, gnutls_certificate_allocate_credentials);
169 LOAD_GNUTLS_FN (library, gnutls_certificate_free_credentials);
170 LOAD_GNUTLS_FN (library, gnutls_certificate_get_peers);
171 LOAD_GNUTLS_FN (library, gnutls_certificate_set_verify_flags);
172 LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_crl_file);
173 LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_key_file);
174 LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_trust_file);
175 LOAD_GNUTLS_FN (library, gnutls_certificate_type_get);
176 LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
177 LOAD_GNUTLS_FN (library, gnutls_credentials_set);
178 LOAD_GNUTLS_FN (library, gnutls_deinit);
179 LOAD_GNUTLS_FN (library, gnutls_dh_set_prime_bits);
180 LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
181 LOAD_GNUTLS_FN (library, gnutls_global_init);
182 LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
183 #ifdef HAVE_GNUTLS3
184 LOAD_GNUTLS_FN (library, gnutls_global_set_audit_log_function);
185 #endif
186 LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
187 LOAD_GNUTLS_FN (library, gnutls_global_set_mem_functions);
188 LOAD_GNUTLS_FN (library, gnutls_handshake);
189 LOAD_GNUTLS_FN (library, gnutls_init);
190 LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
191 LOAD_GNUTLS_FN (library, gnutls_record_check_pending);
192 LOAD_GNUTLS_FN (library, gnutls_record_recv);
193 LOAD_GNUTLS_FN (library, gnutls_record_send);
194 LOAD_GNUTLS_FN (library, gnutls_strerror);
195 LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
196 LOAD_GNUTLS_FN (library, gnutls_check_version);
197 /* We don't need to call gnutls_transport_set_lowat in GnuTLS 2.11.1
198 and later, and the function was removed entirely in 3.0.0. */
199 if (!fn_gnutls_check_version ("2.11.1"))
200 LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
201 LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
202 LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
203 LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
204 LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
205 LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
206 LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
207 LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
209 max_log_level = global_gnutls_log_level;
212 Lisp_Object name = CAR_SAFE (Fget (Qgnutls_dll, QCloaded_from));
213 GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
214 STRINGP (name) ? (const char *) SDATA (name) : "unknown");
217 return 1;
220 #else /* !WINDOWSNT */
222 #define fn_gnutls_alert_get gnutls_alert_get
223 #define fn_gnutls_alert_get_name gnutls_alert_get_name
224 #define fn_gnutls_alert_send_appropriate gnutls_alert_send_appropriate
225 #define fn_gnutls_anon_allocate_client_credentials gnutls_anon_allocate_client_credentials
226 #define fn_gnutls_anon_free_client_credentials gnutls_anon_free_client_credentials
227 #define fn_gnutls_bye gnutls_bye
228 #define fn_gnutls_certificate_allocate_credentials gnutls_certificate_allocate_credentials
229 #define fn_gnutls_certificate_free_credentials gnutls_certificate_free_credentials
230 #define fn_gnutls_certificate_get_peers gnutls_certificate_get_peers
231 #define fn_gnutls_certificate_set_verify_flags gnutls_certificate_set_verify_flags
232 #define fn_gnutls_certificate_set_x509_crl_file gnutls_certificate_set_x509_crl_file
233 #define fn_gnutls_certificate_set_x509_key_file gnutls_certificate_set_x509_key_file
234 #define fn_gnutls_certificate_set_x509_trust_file gnutls_certificate_set_x509_trust_file
235 #define fn_gnutls_certificate_type_get gnutls_certificate_type_get
236 #define fn_gnutls_certificate_verify_peers2 gnutls_certificate_verify_peers2
237 #define fn_gnutls_credentials_set gnutls_credentials_set
238 #define fn_gnutls_deinit gnutls_deinit
239 #define fn_gnutls_dh_set_prime_bits gnutls_dh_set_prime_bits
240 #define fn_gnutls_error_is_fatal gnutls_error_is_fatal
241 #define fn_gnutls_global_init gnutls_global_init
242 #define fn_gnutls_global_set_log_function gnutls_global_set_log_function
243 #ifdef HAVE_GNUTLS3
244 #define fn_gnutls_global_set_audit_log_function gnutls_global_set_audit_log_function
245 #endif
246 #define fn_gnutls_global_set_log_level gnutls_global_set_log_level
247 #define fn_gnutls_global_set_mem_functions gnutls_global_set_mem_functions
248 #define fn_gnutls_handshake gnutls_handshake
249 #define fn_gnutls_init gnutls_init
250 #define fn_gnutls_priority_set_direct gnutls_priority_set_direct
251 #define fn_gnutls_record_check_pending gnutls_record_check_pending
252 #define fn_gnutls_record_recv gnutls_record_recv
253 #define fn_gnutls_record_send gnutls_record_send
254 #define fn_gnutls_strerror gnutls_strerror
255 #ifdef WINDOWSNT
256 #define fn_gnutls_transport_set_errno gnutls_transport_set_errno
257 #endif
258 #define fn_gnutls_transport_set_ptr2 gnutls_transport_set_ptr2
259 #define fn_gnutls_x509_crt_check_hostname gnutls_x509_crt_check_hostname
260 #define fn_gnutls_x509_crt_deinit gnutls_x509_crt_deinit
261 #define fn_gnutls_x509_crt_import gnutls_x509_crt_import
262 #define fn_gnutls_x509_crt_init gnutls_x509_crt_init
264 #endif /* !WINDOWSNT */
267 #ifdef HAVE_GNUTLS3
268 /* Function to log a simple audit message. */
269 static void
270 gnutls_audit_log_function (gnutls_session_t session, const char* string)
272 if (global_gnutls_log_level >= 1)
274 message ("gnutls.c: [audit] %s", string);
277 #endif
279 /* Function to log a simple message. */
280 static void
281 gnutls_log_function (int level, const char* string)
283 message ("gnutls.c: [%d] %s", level, string);
286 /* Function to log a message and a string. */
287 static void
288 gnutls_log_function2 (int level, const char* string, const char* extra)
290 message ("gnutls.c: [%d] %s %s", level, string, extra);
293 /* Function to log a message and an integer. */
294 static void
295 gnutls_log_function2i (int level, const char* string, int extra)
297 message ("gnutls.c: [%d] %s %d", level, string, extra);
300 static int
301 emacs_gnutls_handshake (struct Lisp_Process *proc)
303 gnutls_session_t state = proc->gnutls_state;
304 int ret;
306 if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
307 return -1;
309 if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
311 #ifdef WINDOWSNT
312 /* On W32 we cannot transfer socket handles between different runtime
313 libraries, so we tell GnuTLS to use our special push/pull
314 functions. */
315 fn_gnutls_transport_set_ptr2 (state,
316 (gnutls_transport_ptr_t) proc,
317 (gnutls_transport_ptr_t) proc);
318 fn_gnutls_transport_set_push_function (state, &emacs_gnutls_push);
319 fn_gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
321 /* For non blocking sockets or other custom made pull/push
322 functions the gnutls_transport_set_lowat must be called, with
323 a zero low water mark value. (GnuTLS 2.10.4 documentation)
325 (Note: this is probably not strictly necessary as the lowat
326 value is only used when no custom pull/push functions are
327 set.) */
328 /* According to GnuTLS NEWS file, lowat level has been set to
329 zero by default in version 2.11.1, and the function
330 gnutls_transport_set_lowat was removed from the library in
331 version 2.99.0. */
332 if (!fn_gnutls_check_version ("2.11.1"))
333 fn_gnutls_transport_set_lowat (state, 0);
334 #else
335 /* This is how GnuTLS takes sockets: as file descriptors passed
336 in. For an Emacs process socket, infd and outfd are the
337 same but we use this two-argument version for clarity. */
338 fn_gnutls_transport_set_ptr2 (state,
339 (gnutls_transport_ptr_t) (long) proc->infd,
340 (gnutls_transport_ptr_t) (long) proc->outfd);
341 #endif
343 proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
348 ret = fn_gnutls_handshake (state);
349 emacs_gnutls_handle_error (state, ret);
350 QUIT;
352 while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
354 proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
356 if (ret == GNUTLS_E_SUCCESS)
358 /* Here we're finally done. */
359 proc->gnutls_initstage = GNUTLS_STAGE_READY;
361 else
363 fn_gnutls_alert_send_appropriate (state, ret);
365 return ret;
368 ptrdiff_t
369 emacs_gnutls_record_check_pending (gnutls_session_t state)
371 return fn_gnutls_record_check_pending (state);
374 #ifdef WINDOWSNT
375 void
376 emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
378 fn_gnutls_transport_set_errno (state, err);
380 #endif
382 ptrdiff_t
383 emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
385 ssize_t rtnval = 0;
386 ptrdiff_t bytes_written;
387 gnutls_session_t state = proc->gnutls_state;
389 if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
391 errno = EAGAIN;
392 return 0;
395 bytes_written = 0;
397 while (nbyte > 0)
399 rtnval = fn_gnutls_record_send (state, buf, nbyte);
401 if (rtnval < 0)
403 if (rtnval == GNUTLS_E_INTERRUPTED)
404 continue;
405 else
407 /* If we get GNUTLS_E_AGAIN, then set errno
408 appropriately so that send_process retries the
409 correct way instead of erroring out. */
410 if (rtnval == GNUTLS_E_AGAIN)
411 errno = EAGAIN;
412 break;
416 buf += rtnval;
417 nbyte -= rtnval;
418 bytes_written += rtnval;
421 emacs_gnutls_handle_error (state, rtnval);
422 return (bytes_written);
425 ptrdiff_t
426 emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
428 ssize_t rtnval;
429 gnutls_session_t state = proc->gnutls_state;
431 int log_level = proc->gnutls_log_level;
433 if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
435 /* If the handshake count is under the limit, try the handshake
436 again and increment the handshake count. This count is kept
437 per process (connection), not globally. */
438 if (proc->gnutls_handshakes_tried < GNUTLS_EMACS_HANDSHAKES_LIMIT)
440 proc->gnutls_handshakes_tried++;
441 emacs_gnutls_handshake (proc);
442 GNUTLS_LOG2i (5, log_level, "Retried handshake",
443 proc->gnutls_handshakes_tried);
444 return -1;
447 GNUTLS_LOG (2, log_level, "Giving up on handshake; resetting retries");
448 proc->gnutls_handshakes_tried = 0;
449 return 0;
451 rtnval = fn_gnutls_record_recv (state, buf, nbyte);
452 if (rtnval >= 0)
453 return rtnval;
454 else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
455 /* The peer closed the connection. */
456 return 0;
457 else if (emacs_gnutls_handle_error (state, rtnval))
458 /* non-fatal error */
459 return -1;
460 else {
461 /* a fatal error occurred */
462 return 0;
466 /* Report a GnuTLS error to the user.
467 Return true if the error code was successfully handled. */
468 static bool
469 emacs_gnutls_handle_error (gnutls_session_t session, int err)
471 int max_log_level = 0;
473 bool ret;
474 const char *str;
476 /* TODO: use a Lisp_Object generated by gnutls_make_error? */
477 if (err >= 0)
478 return 1;
480 max_log_level = global_gnutls_log_level;
482 /* TODO: use gnutls-error-fatalp and gnutls-error-string. */
484 str = fn_gnutls_strerror (err);
485 if (!str)
486 str = "unknown";
488 if (fn_gnutls_error_is_fatal (err))
490 ret = 0;
491 GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
493 else
495 ret = 1;
497 switch (err)
499 case GNUTLS_E_AGAIN:
500 GNUTLS_LOG2 (3,
501 max_log_level,
502 "retry:",
503 str);
504 default:
505 GNUTLS_LOG2 (1,
506 max_log_level,
507 "non-fatal error:",
508 str);
512 if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
513 || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
515 int alert = fn_gnutls_alert_get (session);
516 int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
517 str = fn_gnutls_alert_get_name (alert);
518 if (!str)
519 str = "unknown";
521 GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str);
523 return ret;
526 /* convert an integer error to a Lisp_Object; it will be either a
527 known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or
528 simply the integer value of the error. GNUTLS_E_SUCCESS is mapped
529 to Qt. */
530 static Lisp_Object
531 gnutls_make_error (int err)
533 switch (err)
535 case GNUTLS_E_SUCCESS:
536 return Qt;
537 case GNUTLS_E_AGAIN:
538 return Qgnutls_e_again;
539 case GNUTLS_E_INTERRUPTED:
540 return Qgnutls_e_interrupted;
541 case GNUTLS_E_INVALID_SESSION:
542 return Qgnutls_e_invalid_session;
545 return make_number (err);
548 Lisp_Object
549 emacs_gnutls_deinit (Lisp_Object proc)
551 int log_level;
553 CHECK_PROCESS (proc);
555 if (XPROCESS (proc)->gnutls_p == 0)
556 return Qnil;
558 log_level = XPROCESS (proc)->gnutls_log_level;
560 if (XPROCESS (proc)->gnutls_x509_cred)
562 GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
563 fn_gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
564 XPROCESS (proc)->gnutls_x509_cred = NULL;
567 if (XPROCESS (proc)->gnutls_anon_cred)
569 GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
570 fn_gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
571 XPROCESS (proc)->gnutls_anon_cred = NULL;
574 if (XPROCESS (proc)->gnutls_state)
576 fn_gnutls_deinit (XPROCESS (proc)->gnutls_state);
577 XPROCESS (proc)->gnutls_state = NULL;
578 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
579 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
582 XPROCESS (proc)->gnutls_p = 0;
583 return Qt;
586 DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
587 doc: /* Return the GnuTLS init stage of process PROC.
588 See also `gnutls-boot'. */)
589 (Lisp_Object proc)
591 CHECK_PROCESS (proc);
593 return make_number (GNUTLS_INITSTAGE (proc));
596 DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
597 doc: /* Return t if ERROR indicates a GnuTLS problem.
598 ERROR is an integer or a symbol with an integer `gnutls-code' property.
599 usage: (gnutls-errorp ERROR) */)
600 (Lisp_Object err)
602 if (EQ (err, Qt)) return Qnil;
604 return Qt;
607 DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0,
608 doc: /* Check if ERROR is fatal.
609 ERROR is an integer or a symbol with an integer `gnutls-code' property.
610 usage: (gnutls-error-fatalp ERROR) */)
611 (Lisp_Object err)
613 Lisp_Object code;
615 if (EQ (err, Qt)) return Qnil;
617 if (SYMBOLP (err))
619 code = Fget (err, Qgnutls_code);
620 if (NUMBERP (code))
622 err = code;
624 else
626 error ("Symbol has no numeric gnutls-code property");
630 if (! TYPE_RANGED_INTEGERP (int, err))
631 error ("Not an error symbol or code");
633 if (0 == fn_gnutls_error_is_fatal (XINT (err)))
634 return Qnil;
636 return Qt;
639 DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0,
640 doc: /* Return a description of ERROR.
641 ERROR is an integer or a symbol with an integer `gnutls-code' property.
642 usage: (gnutls-error-string ERROR) */)
643 (Lisp_Object err)
645 Lisp_Object code;
647 if (EQ (err, Qt)) return build_string ("Not an error");
649 if (SYMBOLP (err))
651 code = Fget (err, Qgnutls_code);
652 if (NUMBERP (code))
654 err = code;
656 else
658 return build_string ("Symbol has no numeric gnutls-code property");
662 if (! TYPE_RANGED_INTEGERP (int, err))
663 return build_string ("Not an error symbol or code");
665 return build_string (fn_gnutls_strerror (XINT (err)));
668 DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
669 doc: /* Deallocate GnuTLS resources associated with process PROC.
670 See also `gnutls-init'. */)
671 (Lisp_Object proc)
673 return emacs_gnutls_deinit (proc);
676 DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
677 doc: /* Return t if GnuTLS is available in this instance of Emacs. */)
678 (void)
680 #ifdef WINDOWSNT
681 Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
682 if (CONSP (found))
683 return XCDR (found);
684 else
686 Lisp_Object status;
687 status = init_gnutls_functions () ? Qt : Qnil;
688 Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
689 return status;
691 #else
692 return Qt;
693 #endif
697 /* Initializes global GnuTLS state to defaults.
698 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
699 Returns zero on success. */
700 static Lisp_Object
701 emacs_gnutls_global_init (void)
703 int ret = GNUTLS_E_SUCCESS;
705 if (!gnutls_global_initialized)
707 fn_gnutls_global_set_mem_functions (xmalloc, xmalloc, NULL,
708 xrealloc, xfree);
709 ret = fn_gnutls_global_init ();
711 gnutls_global_initialized = 1;
713 return gnutls_make_error (ret);
716 #if 0
717 /* Deinitializes global GnuTLS state.
718 See also `gnutls-global-init'. */
719 static Lisp_Object
720 emacs_gnutls_global_deinit (void)
722 if (gnutls_global_initialized)
723 gnutls_global_deinit ();
725 gnutls_global_initialized = 0;
727 return gnutls_make_error (GNUTLS_E_SUCCESS);
729 #endif
731 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
732 doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
733 Currently only client mode is supported. Return a success/failure
734 value you can check with `gnutls-errorp'.
736 TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
737 PROPLIST is a property list with the following keys:
739 :hostname is a string naming the remote host.
741 :priority is a GnuTLS priority string, defaults to "NORMAL".
743 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
745 :crlfiles is a list of PEM-encoded CRL lists for `gnutls-x509pki'.
747 :keylist is an alist of PEM-encoded key files and PEM-encoded
748 certificates for `gnutls-x509pki'.
750 :callbacks is an alist of callback functions, see below.
752 :loglevel is the debug level requested from GnuTLS, try 4.
754 :verify-flags is a bitset as per GnuTLS'
755 gnutls_certificate_set_verify_flags.
757 :verify-hostname-error is ignored. Pass :hostname in :verify-error
758 instead.
760 :verify-error is a list of symbols to express verification checks or
761 `t' to do all checks. Currently it can contain `:trustfiles' and
762 `:hostname' to verify the certificate or the hostname respectively.
764 :min-prime-bits is the minimum accepted number of bits the client will
765 accept in Diffie-Hellman key exchange.
767 The debug level will be set for this process AND globally for GnuTLS.
768 So if you set it higher or lower at any point, it affects global
769 debugging.
771 Note that the priority is set on the client. The server does not use
772 the protocols's priority except for disabling protocols that were not
773 specified.
775 Processes must be initialized with this function before other GnuTLS
776 functions are used. This function allocates resources which can only
777 be deallocated by calling `gnutls-deinit' or by calling it again.
779 The callbacks alist can have a `verify' key, associated with a
780 verification function (UNUSED).
782 Each authentication type may need additional information in order to
783 work. For X.509 PKI (`gnutls-x509pki'), you probably need at least
784 one trustfile (usually a CA bundle). */)
785 (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
787 int ret = GNUTLS_E_SUCCESS;
788 int max_log_level = 0;
790 gnutls_session_t state;
791 gnutls_certificate_credentials_t x509_cred = NULL;
792 gnutls_anon_client_credentials_t anon_cred = NULL;
793 Lisp_Object global_init;
794 char const *priority_string_ptr = "NORMAL"; /* default priority string. */
795 unsigned int peer_verification;
796 char* c_hostname;
798 /* Placeholders for the property list elements. */
799 Lisp_Object priority_string;
800 Lisp_Object trustfiles;
801 Lisp_Object crlfiles;
802 Lisp_Object keylist;
803 /* Lisp_Object callbacks; */
804 Lisp_Object loglevel;
805 Lisp_Object hostname;
806 Lisp_Object verify_error;
807 Lisp_Object prime_bits;
809 CHECK_PROCESS (proc);
810 CHECK_SYMBOL (type);
811 CHECK_LIST (proplist);
813 if (NILP (Fgnutls_available_p ()))
814 error ("GnuTLS not available");
816 if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
817 error ("Invalid GnuTLS credential type");
819 hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname);
820 priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority);
821 trustfiles = Fplist_get (proplist, QCgnutls_bootprop_trustfiles);
822 keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist);
823 crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);
824 loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel);
825 verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error);
826 prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);
828 if (NILP (Flistp (verify_error)))
829 error ("gnutls-boot: invalid :verify_error parameter (not a list)");
831 if (!STRINGP (hostname))
832 error ("gnutls-boot: invalid :hostname parameter (not a string)");
833 c_hostname = SSDATA (hostname);
835 state = XPROCESS (proc)->gnutls_state;
837 if (TYPE_RANGED_INTEGERP (int, loglevel))
839 fn_gnutls_global_set_log_function (gnutls_log_function);
840 #ifdef HAVE_GNUTLS3
841 fn_gnutls_global_set_audit_log_function (gnutls_audit_log_function);
842 #endif
843 fn_gnutls_global_set_log_level (XINT (loglevel));
844 max_log_level = XINT (loglevel);
845 XPROCESS (proc)->gnutls_log_level = max_log_level;
848 /* always initialize globals. */
849 global_init = emacs_gnutls_global_init ();
850 if (! NILP (Fgnutls_errorp (global_init)))
851 return global_init;
853 /* Before allocating new credentials, deallocate any credentials
854 that PROC might already have. */
855 emacs_gnutls_deinit (proc);
857 /* Mark PROC as a GnuTLS process. */
858 XPROCESS (proc)->gnutls_state = NULL;
859 XPROCESS (proc)->gnutls_x509_cred = NULL;
860 XPROCESS (proc)->gnutls_anon_cred = NULL;
861 pset_gnutls_cred_type (XPROCESS (proc), type);
862 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
864 GNUTLS_LOG (1, max_log_level, "allocating credentials");
865 if (EQ (type, Qgnutls_x509pki))
867 Lisp_Object verify_flags;
868 unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
870 GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
871 fn_gnutls_certificate_allocate_credentials (&x509_cred);
872 XPROCESS (proc)->gnutls_x509_cred = x509_cred;
874 verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
875 if (NUMBERP (verify_flags))
877 gnutls_verify_flags = XINT (verify_flags);
878 GNUTLS_LOG (2, max_log_level, "setting verification flags");
880 else if (NILP (verify_flags))
881 GNUTLS_LOG (2, max_log_level, "using default verification flags");
882 else
883 GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
885 fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
887 else /* Qgnutls_anon: */
889 GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
890 fn_gnutls_anon_allocate_client_credentials (&anon_cred);
891 XPROCESS (proc)->gnutls_anon_cred = anon_cred;
894 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
896 if (EQ (type, Qgnutls_x509pki))
898 /* TODO: GNUTLS_X509_FMT_DER is also an option. */
899 int file_format = GNUTLS_X509_FMT_PEM;
900 Lisp_Object tail;
902 for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
904 Lisp_Object trustfile = XCAR (tail);
905 if (STRINGP (trustfile))
907 GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
908 SSDATA (trustfile));
909 trustfile = ENCODE_FILE (trustfile);
910 #ifdef WINDOWSNT
911 /* Since GnuTLS doesn't support UTF-8 or UTF-16 encoded
912 file names on Windows, we need to re-encode the file
913 name using the current ANSI codepage. */
914 trustfile = ansi_encode_filename (trustfile);
915 #endif
916 ret = fn_gnutls_certificate_set_x509_trust_file
917 (x509_cred,
918 SSDATA (trustfile),
919 file_format);
921 if (ret < GNUTLS_E_SUCCESS)
922 return gnutls_make_error (ret);
924 else
926 emacs_gnutls_deinit (proc);
927 error ("Invalid trustfile");
931 for (tail = crlfiles; CONSP (tail); tail = XCDR (tail))
933 Lisp_Object crlfile = XCAR (tail);
934 if (STRINGP (crlfile))
936 GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
937 SSDATA (crlfile));
938 crlfile = ENCODE_FILE (crlfile);
939 #ifdef WINDOWSNT
940 crlfile = ansi_encode_filename (crlfile);
941 #endif
942 ret = fn_gnutls_certificate_set_x509_crl_file
943 (x509_cred, SSDATA (crlfile), file_format);
945 if (ret < GNUTLS_E_SUCCESS)
946 return gnutls_make_error (ret);
948 else
950 emacs_gnutls_deinit (proc);
951 error ("Invalid CRL file");
955 for (tail = keylist; CONSP (tail); tail = XCDR (tail))
957 Lisp_Object keyfile = Fcar (XCAR (tail));
958 Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
959 if (STRINGP (keyfile) && STRINGP (certfile))
961 GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
962 SSDATA (keyfile));
963 GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
964 SSDATA (certfile));
965 keyfile = ENCODE_FILE (keyfile);
966 certfile = ENCODE_FILE (certfile);
967 #ifdef WINDOWSNT
968 keyfile = ansi_encode_filename (keyfile);
969 certfile = ansi_encode_filename (certfile);
970 #endif
971 ret = fn_gnutls_certificate_set_x509_key_file
972 (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
974 if (ret < GNUTLS_E_SUCCESS)
975 return gnutls_make_error (ret);
977 else
979 emacs_gnutls_deinit (proc);
980 error (STRINGP (keyfile) ? "Invalid client cert file"
981 : "Invalid client key file");
986 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
987 GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
988 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
990 /* Call gnutls_init here: */
992 GNUTLS_LOG (1, max_log_level, "gnutls_init");
993 ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
994 XPROCESS (proc)->gnutls_state = state;
995 if (ret < GNUTLS_E_SUCCESS)
996 return gnutls_make_error (ret);
997 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
999 if (STRINGP (priority_string))
1001 priority_string_ptr = SSDATA (priority_string);
1002 GNUTLS_LOG2 (1, max_log_level, "got non-default priority string:",
1003 priority_string_ptr);
1005 else
1007 GNUTLS_LOG2 (1, max_log_level, "using default priority string:",
1008 priority_string_ptr);
1011 GNUTLS_LOG (1, max_log_level, "setting the priority string");
1012 ret = fn_gnutls_priority_set_direct (state,
1013 priority_string_ptr,
1014 NULL);
1015 if (ret < GNUTLS_E_SUCCESS)
1016 return gnutls_make_error (ret);
1018 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
1020 if (INTEGERP (prime_bits))
1021 fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
1023 ret = EQ (type, Qgnutls_x509pki)
1024 ? fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
1025 : fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
1026 if (ret < GNUTLS_E_SUCCESS)
1027 return gnutls_make_error (ret);
1029 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
1030 ret = emacs_gnutls_handshake (XPROCESS (proc));
1031 if (ret < GNUTLS_E_SUCCESS)
1032 return gnutls_make_error (ret);
1034 /* Now verify the peer, following
1035 http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
1036 The peer should present at least one certificate in the chain; do a
1037 check of the certificate's hostname with
1038 gnutls_x509_crt_check_hostname() against :hostname. */
1040 ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
1041 if (ret < GNUTLS_E_SUCCESS)
1042 return gnutls_make_error (ret);
1044 if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
1045 message ("%s certificate could not be verified.", c_hostname);
1047 if (peer_verification & GNUTLS_CERT_REVOKED)
1048 GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
1049 c_hostname);
1051 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
1052 GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
1053 c_hostname);
1055 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
1056 GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
1057 c_hostname);
1059 if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
1060 GNUTLS_LOG2 (1, max_log_level,
1061 "certificate was signed with an insecure algorithm:",
1062 c_hostname);
1064 if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
1065 GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
1066 c_hostname);
1068 if (peer_verification & GNUTLS_CERT_EXPIRED)
1069 GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
1070 c_hostname);
1072 if (peer_verification != 0)
1074 if (!NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error)))
1076 emacs_gnutls_deinit (proc);
1077 error ("Certificate validation failed %s, verification code %d",
1078 c_hostname, peer_verification);
1080 else
1082 GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
1083 c_hostname);
1087 /* Up to here the process is the same for X.509 certificates and
1088 OpenPGP keys. From now on X.509 certificates are assumed. This
1089 can be easily extended to work with openpgp keys as well. */
1090 if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
1092 gnutls_x509_crt_t gnutls_verify_cert;
1093 const gnutls_datum_t *gnutls_verify_cert_list;
1094 unsigned int gnutls_verify_cert_list_size;
1096 ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
1097 if (ret < GNUTLS_E_SUCCESS)
1098 return gnutls_make_error (ret);
1100 gnutls_verify_cert_list =
1101 fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
1103 if (gnutls_verify_cert_list == NULL)
1105 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1106 emacs_gnutls_deinit (proc);
1107 error ("No x509 certificate was found\n");
1110 /* We only check the first certificate in the given chain. */
1111 ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
1112 &gnutls_verify_cert_list[0],
1113 GNUTLS_X509_FMT_DER);
1115 if (ret < GNUTLS_E_SUCCESS)
1117 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1118 return gnutls_make_error (ret);
1121 if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
1123 if (!NILP (Fmember (QCgnutls_bootprop_hostname, verify_error)))
1125 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1126 emacs_gnutls_deinit (proc);
1127 error ("The x509 certificate does not match \"%s\"", c_hostname);
1129 else
1131 GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
1132 c_hostname);
1135 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1138 /* Set this flag only if the whole initialization succeeded. */
1139 XPROCESS (proc)->gnutls_p = 1;
1141 return gnutls_make_error (ret);
1144 DEFUN ("gnutls-bye", Fgnutls_bye,
1145 Sgnutls_bye, 2, 2, 0,
1146 doc: /* Terminate current GnuTLS connection for process PROC.
1147 The connection should have been initiated using `gnutls-handshake'.
1149 If CONT is not nil the TLS connection gets terminated and further
1150 receives and sends will be disallowed. If the return value is zero you
1151 may continue using the connection. If CONT is nil, GnuTLS actually
1152 sends an alert containing a close request and waits for the peer to
1153 reply with the same message. In order to reuse the connection you
1154 should wait for an EOF from the peer.
1156 This function may also return `gnutls-e-again', or
1157 `gnutls-e-interrupted'. */)
1158 (Lisp_Object proc, Lisp_Object cont)
1160 gnutls_session_t state;
1161 int ret;
1163 CHECK_PROCESS (proc);
1165 state = XPROCESS (proc)->gnutls_state;
1167 ret = fn_gnutls_bye (state,
1168 NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
1170 return gnutls_make_error (ret);
1173 void
1174 syms_of_gnutls (void)
1176 gnutls_global_initialized = 0;
1178 DEFSYM (Qgnutls_dll, "gnutls");
1179 DEFSYM (Qgnutls_code, "gnutls-code");
1180 DEFSYM (Qgnutls_anon, "gnutls-anon");
1181 DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
1182 DEFSYM (QCgnutls_bootprop_hostname, ":hostname");
1183 DEFSYM (QCgnutls_bootprop_priority, ":priority");
1184 DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles");
1185 DEFSYM (QCgnutls_bootprop_keylist, ":keylist");
1186 DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
1187 DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks");
1188 DEFSYM (QCgnutls_bootprop_callbacks_verify, "verify");
1189 DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
1190 DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
1191 DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");
1192 DEFSYM (QCgnutls_bootprop_verify_error, ":verify-error");
1194 DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
1195 Fput (Qgnutls_e_interrupted, Qgnutls_code,
1196 make_number (GNUTLS_E_INTERRUPTED));
1198 DEFSYM (Qgnutls_e_again, "gnutls-e-again");
1199 Fput (Qgnutls_e_again, Qgnutls_code,
1200 make_number (GNUTLS_E_AGAIN));
1202 DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session");
1203 Fput (Qgnutls_e_invalid_session, Qgnutls_code,
1204 make_number (GNUTLS_E_INVALID_SESSION));
1206 DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake");
1207 Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code,
1208 make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
1210 defsubr (&Sgnutls_get_initstage);
1211 defsubr (&Sgnutls_errorp);
1212 defsubr (&Sgnutls_error_fatalp);
1213 defsubr (&Sgnutls_error_string);
1214 defsubr (&Sgnutls_boot);
1215 defsubr (&Sgnutls_deinit);
1216 defsubr (&Sgnutls_bye);
1217 defsubr (&Sgnutls_available_p);
1219 DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
1220 doc: /* Logging level used by the GnuTLS functions.
1221 Set this larger than 0 to get debug output in the *Messages* buffer.
1222 1 is for important messages, 2 is for debug data, and higher numbers
1223 are as per the GnuTLS logging conventions. */);
1224 global_gnutls_log_level = 0;
1227 #endif /* HAVE_GNUTLS */