Backport the :end-of-capability fix
[emacs.git] / src / gnutls.c
blobd363fea2599d323c0ce94e64bbc2a06ceaa6a793
1 /* GnuTLS glue for GNU Emacs.
2 Copyright (C) 2010-2015 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 (int, gnutls_handshake, (gnutls_session_t));
120 DEF_GNUTLS_FN (int, gnutls_init, (gnutls_session_t *, unsigned int));
121 DEF_GNUTLS_FN (int, gnutls_priority_set_direct,
122 (gnutls_session_t, const char *, const char **));
123 DEF_GNUTLS_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
124 DEF_GNUTLS_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
125 DEF_GNUTLS_FN (ssize_t, gnutls_record_send,
126 (gnutls_session_t, const void *, size_t));
127 DEF_GNUTLS_FN (const char *, gnutls_strerror, (int));
128 DEF_GNUTLS_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
129 DEF_GNUTLS_FN (const char *, gnutls_check_version, (const char *));
130 DEF_GNUTLS_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
131 DEF_GNUTLS_FN (void, gnutls_transport_set_ptr2,
132 (gnutls_session_t, gnutls_transport_ptr_t,
133 gnutls_transport_ptr_t));
134 DEF_GNUTLS_FN (void, gnutls_transport_set_pull_function,
135 (gnutls_session_t, gnutls_pull_func));
136 DEF_GNUTLS_FN (void, gnutls_transport_set_push_function,
137 (gnutls_session_t, gnutls_push_func));
138 DEF_GNUTLS_FN (int, gnutls_x509_crt_check_hostname,
139 (gnutls_x509_crt_t, const char *));
140 DEF_GNUTLS_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
141 DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
142 (gnutls_x509_crt_t, const gnutls_datum_t *,
143 gnutls_x509_crt_fmt_t));
144 DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
146 static bool
147 init_gnutls_functions (void)
149 HMODULE library;
150 int max_log_level = 1;
152 if (!(library = w32_delayed_load (Qgnutls_dll)))
154 GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
155 return 0;
158 LOAD_GNUTLS_FN (library, gnutls_alert_get);
159 LOAD_GNUTLS_FN (library, gnutls_alert_get_name);
160 LOAD_GNUTLS_FN (library, gnutls_alert_send_appropriate);
161 LOAD_GNUTLS_FN (library, gnutls_anon_allocate_client_credentials);
162 LOAD_GNUTLS_FN (library, gnutls_anon_free_client_credentials);
163 LOAD_GNUTLS_FN (library, gnutls_bye);
164 LOAD_GNUTLS_FN (library, gnutls_certificate_allocate_credentials);
165 LOAD_GNUTLS_FN (library, gnutls_certificate_free_credentials);
166 LOAD_GNUTLS_FN (library, gnutls_certificate_get_peers);
167 LOAD_GNUTLS_FN (library, gnutls_certificate_set_verify_flags);
168 LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_crl_file);
169 LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_key_file);
170 LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_trust_file);
171 LOAD_GNUTLS_FN (library, gnutls_certificate_type_get);
172 LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
173 LOAD_GNUTLS_FN (library, gnutls_credentials_set);
174 LOAD_GNUTLS_FN (library, gnutls_deinit);
175 LOAD_GNUTLS_FN (library, gnutls_dh_set_prime_bits);
176 LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
177 LOAD_GNUTLS_FN (library, gnutls_global_init);
178 LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
179 #ifdef HAVE_GNUTLS3
180 LOAD_GNUTLS_FN (library, gnutls_global_set_audit_log_function);
181 #endif
182 LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
183 LOAD_GNUTLS_FN (library, gnutls_handshake);
184 LOAD_GNUTLS_FN (library, gnutls_init);
185 LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
186 LOAD_GNUTLS_FN (library, gnutls_record_check_pending);
187 LOAD_GNUTLS_FN (library, gnutls_record_recv);
188 LOAD_GNUTLS_FN (library, gnutls_record_send);
189 LOAD_GNUTLS_FN (library, gnutls_strerror);
190 LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
191 LOAD_GNUTLS_FN (library, gnutls_check_version);
192 /* We don't need to call gnutls_transport_set_lowat in GnuTLS 2.11.1
193 and later, and the function was removed entirely in 3.0.0. */
194 if (!fn_gnutls_check_version ("2.11.1"))
195 LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
196 LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
197 LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
198 LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
199 LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
200 LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
201 LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
202 LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
204 max_log_level = global_gnutls_log_level;
207 Lisp_Object name = CAR_SAFE (Fget (Qgnutls_dll, QCloaded_from));
208 GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
209 STRINGP (name) ? (const char *) SDATA (name) : "unknown");
212 return 1;
215 #else /* !WINDOWSNT */
217 #define fn_gnutls_alert_get gnutls_alert_get
218 #define fn_gnutls_alert_get_name gnutls_alert_get_name
219 #define fn_gnutls_alert_send_appropriate gnutls_alert_send_appropriate
220 #define fn_gnutls_anon_allocate_client_credentials gnutls_anon_allocate_client_credentials
221 #define fn_gnutls_anon_free_client_credentials gnutls_anon_free_client_credentials
222 #define fn_gnutls_bye gnutls_bye
223 #define fn_gnutls_certificate_allocate_credentials gnutls_certificate_allocate_credentials
224 #define fn_gnutls_certificate_free_credentials gnutls_certificate_free_credentials
225 #define fn_gnutls_certificate_get_peers gnutls_certificate_get_peers
226 #define fn_gnutls_certificate_set_verify_flags gnutls_certificate_set_verify_flags
227 #define fn_gnutls_certificate_set_x509_crl_file gnutls_certificate_set_x509_crl_file
228 #define fn_gnutls_certificate_set_x509_key_file gnutls_certificate_set_x509_key_file
229 #define fn_gnutls_certificate_set_x509_trust_file gnutls_certificate_set_x509_trust_file
230 #define fn_gnutls_certificate_type_get gnutls_certificate_type_get
231 #define fn_gnutls_certificate_verify_peers2 gnutls_certificate_verify_peers2
232 #define fn_gnutls_credentials_set gnutls_credentials_set
233 #define fn_gnutls_deinit gnutls_deinit
234 #define fn_gnutls_dh_set_prime_bits gnutls_dh_set_prime_bits
235 #define fn_gnutls_error_is_fatal gnutls_error_is_fatal
236 #define fn_gnutls_global_init gnutls_global_init
237 #define fn_gnutls_global_set_log_function gnutls_global_set_log_function
238 #ifdef HAVE_GNUTLS3
239 #define fn_gnutls_global_set_audit_log_function gnutls_global_set_audit_log_function
240 #endif
241 #define fn_gnutls_global_set_log_level gnutls_global_set_log_level
242 #define fn_gnutls_handshake gnutls_handshake
243 #define fn_gnutls_init gnutls_init
244 #define fn_gnutls_priority_set_direct gnutls_priority_set_direct
245 #define fn_gnutls_record_check_pending gnutls_record_check_pending
246 #define fn_gnutls_record_recv gnutls_record_recv
247 #define fn_gnutls_record_send gnutls_record_send
248 #define fn_gnutls_strerror gnutls_strerror
249 #ifdef WINDOWSNT
250 #define fn_gnutls_transport_set_errno gnutls_transport_set_errno
251 #endif
252 #define fn_gnutls_transport_set_ptr2 gnutls_transport_set_ptr2
253 #define fn_gnutls_x509_crt_check_hostname gnutls_x509_crt_check_hostname
254 #define fn_gnutls_x509_crt_deinit gnutls_x509_crt_deinit
255 #define fn_gnutls_x509_crt_import gnutls_x509_crt_import
256 #define fn_gnutls_x509_crt_init gnutls_x509_crt_init
258 #endif /* !WINDOWSNT */
261 /* Report memory exhaustion if ERR is an out-of-memory indication. */
262 static void
263 check_memory_full (int err)
265 /* When GnuTLS exhausts memory, it doesn't say how much memory it
266 asked for, so tell the Emacs allocator that GnuTLS asked for no
267 bytes. This isn't accurate, but it's good enough. */
268 if (err == GNUTLS_E_MEMORY_ERROR)
269 memory_full (0);
272 #ifdef HAVE_GNUTLS3
273 /* Function to log a simple audit message. */
274 static void
275 gnutls_audit_log_function (gnutls_session_t session, const char* string)
277 if (global_gnutls_log_level >= 1)
279 message ("gnutls.c: [audit] %s", string);
282 #endif
284 /* Function to log a simple message. */
285 static void
286 gnutls_log_function (int level, const char* string)
288 message ("gnutls.c: [%d] %s", level, string);
291 /* Function to log a message and a string. */
292 static void
293 gnutls_log_function2 (int level, const char* string, const char* extra)
295 message ("gnutls.c: [%d] %s %s", level, string, extra);
298 /* Function to log a message and an integer. */
299 static void
300 gnutls_log_function2i (int level, const char* string, int extra)
302 message ("gnutls.c: [%d] %s %d", level, string, extra);
305 static int
306 emacs_gnutls_handshake (struct Lisp_Process *proc)
308 gnutls_session_t state = proc->gnutls_state;
309 int ret;
311 if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
312 return -1;
314 if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
316 #ifdef WINDOWSNT
317 /* On W32 we cannot transfer socket handles between different runtime
318 libraries, so we tell GnuTLS to use our special push/pull
319 functions. */
320 fn_gnutls_transport_set_ptr2 (state,
321 (gnutls_transport_ptr_t) proc,
322 (gnutls_transport_ptr_t) proc);
323 fn_gnutls_transport_set_push_function (state, &emacs_gnutls_push);
324 fn_gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
326 /* For non blocking sockets or other custom made pull/push
327 functions the gnutls_transport_set_lowat must be called, with
328 a zero low water mark value. (GnuTLS 2.10.4 documentation)
330 (Note: this is probably not strictly necessary as the lowat
331 value is only used when no custom pull/push functions are
332 set.) */
333 /* According to GnuTLS NEWS file, lowat level has been set to
334 zero by default in version 2.11.1, and the function
335 gnutls_transport_set_lowat was removed from the library in
336 version 2.99.0. */
337 if (!fn_gnutls_check_version ("2.11.1"))
338 fn_gnutls_transport_set_lowat (state, 0);
339 #else
340 /* This is how GnuTLS takes sockets: as file descriptors passed
341 in. For an Emacs process socket, infd and outfd are the
342 same but we use this two-argument version for clarity. */
343 fn_gnutls_transport_set_ptr2 (state,
344 (gnutls_transport_ptr_t) (long) proc->infd,
345 (gnutls_transport_ptr_t) (long) proc->outfd);
346 #endif
348 proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
353 ret = fn_gnutls_handshake (state);
354 emacs_gnutls_handle_error (state, ret);
355 QUIT;
357 while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
359 proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
361 if (ret == GNUTLS_E_SUCCESS)
363 /* Here we're finally done. */
364 proc->gnutls_initstage = GNUTLS_STAGE_READY;
366 else
368 check_memory_full (fn_gnutls_alert_send_appropriate (state, ret));
370 return ret;
373 ptrdiff_t
374 emacs_gnutls_record_check_pending (gnutls_session_t state)
376 return fn_gnutls_record_check_pending (state);
379 #ifdef WINDOWSNT
380 void
381 emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
383 fn_gnutls_transport_set_errno (state, err);
385 #endif
387 ptrdiff_t
388 emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
390 ssize_t rtnval = 0;
391 ptrdiff_t bytes_written;
392 gnutls_session_t state = proc->gnutls_state;
394 if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
396 errno = EAGAIN;
397 return 0;
400 bytes_written = 0;
402 while (nbyte > 0)
404 rtnval = fn_gnutls_record_send (state, buf, nbyte);
406 if (rtnval < 0)
408 if (rtnval == GNUTLS_E_INTERRUPTED)
409 continue;
410 else
412 /* If we get GNUTLS_E_AGAIN, then set errno
413 appropriately so that send_process retries the
414 correct way instead of erroring out. */
415 if (rtnval == GNUTLS_E_AGAIN)
416 errno = EAGAIN;
417 break;
421 buf += rtnval;
422 nbyte -= rtnval;
423 bytes_written += rtnval;
426 emacs_gnutls_handle_error (state, rtnval);
427 return (bytes_written);
430 ptrdiff_t
431 emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
433 ssize_t rtnval;
434 gnutls_session_t state = proc->gnutls_state;
436 int log_level = proc->gnutls_log_level;
438 if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
440 /* If the handshake count is under the limit, try the handshake
441 again and increment the handshake count. This count is kept
442 per process (connection), not globally. */
443 if (proc->gnutls_handshakes_tried < GNUTLS_EMACS_HANDSHAKES_LIMIT)
445 proc->gnutls_handshakes_tried++;
446 emacs_gnutls_handshake (proc);
447 GNUTLS_LOG2i (5, log_level, "Retried handshake",
448 proc->gnutls_handshakes_tried);
449 return -1;
452 GNUTLS_LOG (2, log_level, "Giving up on handshake; resetting retries");
453 proc->gnutls_handshakes_tried = 0;
454 return 0;
456 rtnval = fn_gnutls_record_recv (state, buf, nbyte);
457 if (rtnval >= 0)
458 return rtnval;
459 else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
460 /* The peer closed the connection. */
461 return 0;
462 else if (emacs_gnutls_handle_error (state, rtnval))
463 /* non-fatal error */
464 return -1;
465 else {
466 /* a fatal error occurred */
467 return 0;
471 /* Report a GnuTLS error to the user.
472 Return true if the error code was successfully handled. */
473 static bool
474 emacs_gnutls_handle_error (gnutls_session_t session, int err)
476 int max_log_level = 0;
478 bool ret;
479 const char *str;
481 /* TODO: use a Lisp_Object generated by gnutls_make_error? */
482 if (err >= 0)
483 return 1;
485 check_memory_full (err);
487 max_log_level = global_gnutls_log_level;
489 /* TODO: use gnutls-error-fatalp and gnutls-error-string. */
491 str = fn_gnutls_strerror (err);
492 if (!str)
493 str = "unknown";
495 if (fn_gnutls_error_is_fatal (err))
497 ret = 0;
498 GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
500 else
502 ret = 1;
504 switch (err)
506 case GNUTLS_E_AGAIN:
507 GNUTLS_LOG2 (3,
508 max_log_level,
509 "retry:",
510 str);
511 default:
512 GNUTLS_LOG2 (1,
513 max_log_level,
514 "non-fatal error:",
515 str);
519 if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
520 || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
522 int alert = fn_gnutls_alert_get (session);
523 int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
524 str = fn_gnutls_alert_get_name (alert);
525 if (!str)
526 str = "unknown";
528 GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str);
530 return ret;
533 /* convert an integer error to a Lisp_Object; it will be either a
534 known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or
535 simply the integer value of the error. GNUTLS_E_SUCCESS is mapped
536 to Qt. */
537 static Lisp_Object
538 gnutls_make_error (int err)
540 switch (err)
542 case GNUTLS_E_SUCCESS:
543 return Qt;
544 case GNUTLS_E_AGAIN:
545 return Qgnutls_e_again;
546 case GNUTLS_E_INTERRUPTED:
547 return Qgnutls_e_interrupted;
548 case GNUTLS_E_INVALID_SESSION:
549 return Qgnutls_e_invalid_session;
552 check_memory_full (err);
553 return make_number (err);
556 Lisp_Object
557 emacs_gnutls_deinit (Lisp_Object proc)
559 int log_level;
561 CHECK_PROCESS (proc);
563 if (XPROCESS (proc)->gnutls_p == 0)
564 return Qnil;
566 log_level = XPROCESS (proc)->gnutls_log_level;
568 if (XPROCESS (proc)->gnutls_x509_cred)
570 GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
571 fn_gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
572 XPROCESS (proc)->gnutls_x509_cred = NULL;
575 if (XPROCESS (proc)->gnutls_anon_cred)
577 GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
578 fn_gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
579 XPROCESS (proc)->gnutls_anon_cred = NULL;
582 if (XPROCESS (proc)->gnutls_state)
584 fn_gnutls_deinit (XPROCESS (proc)->gnutls_state);
585 XPROCESS (proc)->gnutls_state = NULL;
586 if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
587 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
590 XPROCESS (proc)->gnutls_p = 0;
591 return Qt;
594 DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
595 doc: /* Return the GnuTLS init stage of process PROC.
596 See also `gnutls-boot'. */)
597 (Lisp_Object proc)
599 CHECK_PROCESS (proc);
601 return make_number (GNUTLS_INITSTAGE (proc));
604 DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
605 doc: /* Return t if ERROR indicates a GnuTLS problem.
606 ERROR is an integer or a symbol with an integer `gnutls-code' property.
607 usage: (gnutls-errorp ERROR) */)
608 (Lisp_Object err)
610 if (EQ (err, Qt)) return Qnil;
612 return Qt;
615 DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0,
616 doc: /* Check if ERROR is fatal.
617 ERROR is an integer or a symbol with an integer `gnutls-code' property.
618 usage: (gnutls-error-fatalp ERROR) */)
619 (Lisp_Object err)
621 Lisp_Object code;
623 if (EQ (err, Qt)) return Qnil;
625 if (SYMBOLP (err))
627 code = Fget (err, Qgnutls_code);
628 if (NUMBERP (code))
630 err = code;
632 else
634 error ("Symbol has no numeric gnutls-code property");
638 if (! TYPE_RANGED_INTEGERP (int, err))
639 error ("Not an error symbol or code");
641 if (0 == fn_gnutls_error_is_fatal (XINT (err)))
642 return Qnil;
644 return Qt;
647 DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0,
648 doc: /* Return a description of ERROR.
649 ERROR is an integer or a symbol with an integer `gnutls-code' property.
650 usage: (gnutls-error-string ERROR) */)
651 (Lisp_Object err)
653 Lisp_Object code;
655 if (EQ (err, Qt)) return build_string ("Not an error");
657 if (SYMBOLP (err))
659 code = Fget (err, Qgnutls_code);
660 if (NUMBERP (code))
662 err = code;
664 else
666 return build_string ("Symbol has no numeric gnutls-code property");
670 if (! TYPE_RANGED_INTEGERP (int, err))
671 return build_string ("Not an error symbol or code");
673 return build_string (fn_gnutls_strerror (XINT (err)));
676 DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
677 doc: /* Deallocate GnuTLS resources associated with process PROC.
678 See also `gnutls-init'. */)
679 (Lisp_Object proc)
681 return emacs_gnutls_deinit (proc);
684 /* Initializes global GnuTLS state to defaults.
685 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
686 Returns zero on success. */
687 static Lisp_Object
688 emacs_gnutls_global_init (void)
690 int ret = GNUTLS_E_SUCCESS;
692 if (!gnutls_global_initialized)
693 ret = fn_gnutls_global_init ();
695 gnutls_global_initialized = 1;
697 return gnutls_make_error (ret);
700 #if 0
701 /* Deinitializes global GnuTLS state.
702 See also `gnutls-global-init'. */
703 static Lisp_Object
704 emacs_gnutls_global_deinit (void)
706 if (gnutls_global_initialized)
707 gnutls_global_deinit ();
709 gnutls_global_initialized = 0;
711 return gnutls_make_error (GNUTLS_E_SUCCESS);
713 #endif
715 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
716 doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
717 Currently only client mode is supported. Return a success/failure
718 value you can check with `gnutls-errorp'.
720 TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
721 PROPLIST is a property list with the following keys:
723 :hostname is a string naming the remote host.
725 :priority is a GnuTLS priority string, defaults to "NORMAL".
727 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
729 :crlfiles is a list of PEM-encoded CRL lists for `gnutls-x509pki'.
731 :keylist is an alist of PEM-encoded key files and PEM-encoded
732 certificates for `gnutls-x509pki'.
734 :callbacks is an alist of callback functions, see below.
736 :loglevel is the debug level requested from GnuTLS, try 4.
738 :verify-flags is a bitset as per GnuTLS'
739 gnutls_certificate_set_verify_flags.
741 :verify-hostname-error is ignored. Pass :hostname in :verify-error
742 instead.
744 :verify-error is a list of symbols to express verification checks or
745 `t' to do all checks. Currently it can contain `:trustfiles' and
746 `:hostname' to verify the certificate or the hostname respectively.
748 :min-prime-bits is the minimum accepted number of bits the client will
749 accept in Diffie-Hellman key exchange.
751 The debug level will be set for this process AND globally for GnuTLS.
752 So if you set it higher or lower at any point, it affects global
753 debugging.
755 Note that the priority is set on the client. The server does not use
756 the protocols's priority except for disabling protocols that were not
757 specified.
759 Processes must be initialized with this function before other GnuTLS
760 functions are used. This function allocates resources which can only
761 be deallocated by calling `gnutls-deinit' or by calling it again.
763 The callbacks alist can have a `verify' key, associated with a
764 verification function (UNUSED).
766 Each authentication type may need additional information in order to
767 work. For X.509 PKI (`gnutls-x509pki'), you probably need at least
768 one trustfile (usually a CA bundle). */)
769 (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
771 int ret = GNUTLS_E_SUCCESS;
772 int max_log_level = 0;
773 bool verify_error_all = 0;
775 gnutls_session_t state;
776 gnutls_certificate_credentials_t x509_cred = NULL;
777 gnutls_anon_client_credentials_t anon_cred = NULL;
778 Lisp_Object global_init;
779 char const *priority_string_ptr = "NORMAL"; /* default priority string. */
780 unsigned int peer_verification;
781 char* c_hostname;
783 /* Placeholders for the property list elements. */
784 Lisp_Object priority_string;
785 Lisp_Object trustfiles;
786 Lisp_Object crlfiles;
787 Lisp_Object keylist;
788 /* Lisp_Object callbacks; */
789 Lisp_Object loglevel;
790 Lisp_Object hostname;
791 Lisp_Object verify_error;
792 Lisp_Object prime_bits;
794 CHECK_PROCESS (proc);
795 CHECK_SYMBOL (type);
796 CHECK_LIST (proplist);
798 if (NILP (Fgnutls_available_p ()))
799 error ("GnuTLS not available");
801 if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
802 error ("Invalid GnuTLS credential type");
804 hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname);
805 priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority);
806 trustfiles = Fplist_get (proplist, QCgnutls_bootprop_trustfiles);
807 keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist);
808 crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);
809 loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel);
810 verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error);
811 prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);
813 if (EQ (verify_error, Qt))
815 verify_error_all = 1;
817 else if (NILP (Flistp (verify_error)))
819 error ("gnutls-boot: invalid :verify_error parameter (not a list)");
822 if (!STRINGP (hostname))
823 error ("gnutls-boot: invalid :hostname parameter (not a string)");
824 c_hostname = SSDATA (hostname);
826 state = XPROCESS (proc)->gnutls_state;
828 if (TYPE_RANGED_INTEGERP (int, loglevel))
830 fn_gnutls_global_set_log_function (gnutls_log_function);
831 #ifdef HAVE_GNUTLS3
832 fn_gnutls_global_set_audit_log_function (gnutls_audit_log_function);
833 #endif
834 fn_gnutls_global_set_log_level (XINT (loglevel));
835 max_log_level = XINT (loglevel);
836 XPROCESS (proc)->gnutls_log_level = max_log_level;
839 /* always initialize globals. */
840 global_init = emacs_gnutls_global_init ();
841 if (! NILP (Fgnutls_errorp (global_init)))
842 return global_init;
844 /* Before allocating new credentials, deallocate any credentials
845 that PROC might already have. */
846 emacs_gnutls_deinit (proc);
848 /* Mark PROC as a GnuTLS process. */
849 XPROCESS (proc)->gnutls_state = NULL;
850 XPROCESS (proc)->gnutls_x509_cred = NULL;
851 XPROCESS (proc)->gnutls_anon_cred = NULL;
852 pset_gnutls_cred_type (XPROCESS (proc), type);
853 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
855 GNUTLS_LOG (1, max_log_level, "allocating credentials");
856 if (EQ (type, Qgnutls_x509pki))
858 Lisp_Object verify_flags;
859 unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
861 GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
862 check_memory_full ((fn_gnutls_certificate_allocate_credentials
863 (&x509_cred)));
864 XPROCESS (proc)->gnutls_x509_cred = x509_cred;
866 verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
867 if (NUMBERP (verify_flags))
869 gnutls_verify_flags = XINT (verify_flags);
870 GNUTLS_LOG (2, max_log_level, "setting verification flags");
872 else if (NILP (verify_flags))
873 GNUTLS_LOG (2, max_log_level, "using default verification flags");
874 else
875 GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
877 fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
879 else /* Qgnutls_anon: */
881 GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
882 check_memory_full ((fn_gnutls_anon_allocate_client_credentials
883 (&anon_cred)));
884 XPROCESS (proc)->gnutls_anon_cred = anon_cred;
887 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
889 if (EQ (type, Qgnutls_x509pki))
891 /* TODO: GNUTLS_X509_FMT_DER is also an option. */
892 int file_format = GNUTLS_X509_FMT_PEM;
893 Lisp_Object tail;
895 for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
897 Lisp_Object trustfile = XCAR (tail);
898 if (STRINGP (trustfile))
900 GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
901 SSDATA (trustfile));
902 trustfile = ENCODE_FILE (trustfile);
903 #ifdef WINDOWSNT
904 /* Since GnuTLS doesn't support UTF-8 or UTF-16 encoded
905 file names on Windows, we need to re-encode the file
906 name using the current ANSI codepage. */
907 trustfile = ansi_encode_filename (trustfile);
908 #endif
909 ret = fn_gnutls_certificate_set_x509_trust_file
910 (x509_cred,
911 SSDATA (trustfile),
912 file_format);
914 if (ret < GNUTLS_E_SUCCESS)
915 return gnutls_make_error (ret);
917 else
919 emacs_gnutls_deinit (proc);
920 error ("Invalid trustfile");
924 for (tail = crlfiles; CONSP (tail); tail = XCDR (tail))
926 Lisp_Object crlfile = XCAR (tail);
927 if (STRINGP (crlfile))
929 GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
930 SSDATA (crlfile));
931 crlfile = ENCODE_FILE (crlfile);
932 #ifdef WINDOWSNT
933 crlfile = ansi_encode_filename (crlfile);
934 #endif
935 ret = fn_gnutls_certificate_set_x509_crl_file
936 (x509_cred, SSDATA (crlfile), file_format);
938 if (ret < GNUTLS_E_SUCCESS)
939 return gnutls_make_error (ret);
941 else
943 emacs_gnutls_deinit (proc);
944 error ("Invalid CRL file");
948 for (tail = keylist; CONSP (tail); tail = XCDR (tail))
950 Lisp_Object keyfile = Fcar (XCAR (tail));
951 Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
952 if (STRINGP (keyfile) && STRINGP (certfile))
954 GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
955 SSDATA (keyfile));
956 GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
957 SSDATA (certfile));
958 keyfile = ENCODE_FILE (keyfile);
959 certfile = ENCODE_FILE (certfile);
960 #ifdef WINDOWSNT
961 keyfile = ansi_encode_filename (keyfile);
962 certfile = ansi_encode_filename (certfile);
963 #endif
964 ret = fn_gnutls_certificate_set_x509_key_file
965 (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
967 if (ret < GNUTLS_E_SUCCESS)
968 return gnutls_make_error (ret);
970 else
972 emacs_gnutls_deinit (proc);
973 error (STRINGP (keyfile) ? "Invalid client cert file"
974 : "Invalid client key file");
979 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
980 GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
981 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
983 /* Call gnutls_init here: */
985 GNUTLS_LOG (1, max_log_level, "gnutls_init");
986 ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
987 XPROCESS (proc)->gnutls_state = state;
988 if (ret < GNUTLS_E_SUCCESS)
989 return gnutls_make_error (ret);
990 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
992 if (STRINGP (priority_string))
994 priority_string_ptr = SSDATA (priority_string);
995 GNUTLS_LOG2 (1, max_log_level, "got non-default priority string:",
996 priority_string_ptr);
998 else
1000 GNUTLS_LOG2 (1, max_log_level, "using default priority string:",
1001 priority_string_ptr);
1004 GNUTLS_LOG (1, max_log_level, "setting the priority string");
1005 ret = fn_gnutls_priority_set_direct (state,
1006 priority_string_ptr,
1007 NULL);
1008 if (ret < GNUTLS_E_SUCCESS)
1009 return gnutls_make_error (ret);
1011 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
1013 if (INTEGERP (prime_bits))
1014 fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
1016 ret = EQ (type, Qgnutls_x509pki)
1017 ? fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
1018 : fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
1019 if (ret < GNUTLS_E_SUCCESS)
1020 return gnutls_make_error (ret);
1022 GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
1023 ret = emacs_gnutls_handshake (XPROCESS (proc));
1024 if (ret < GNUTLS_E_SUCCESS)
1025 return gnutls_make_error (ret);
1027 /* Now verify the peer, following
1028 http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
1029 The peer should present at least one certificate in the chain; do a
1030 check of the certificate's hostname with
1031 gnutls_x509_crt_check_hostname() against :hostname. */
1033 ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
1034 if (ret < GNUTLS_E_SUCCESS)
1035 return gnutls_make_error (ret);
1037 if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
1038 message ("%s certificate could not be verified.", c_hostname);
1040 if (peer_verification & GNUTLS_CERT_REVOKED)
1041 GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
1042 c_hostname);
1044 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
1045 GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
1046 c_hostname);
1048 if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
1049 GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
1050 c_hostname);
1052 if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
1053 GNUTLS_LOG2 (1, max_log_level,
1054 "certificate was signed with an insecure algorithm:",
1055 c_hostname);
1057 if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
1058 GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
1059 c_hostname);
1061 if (peer_verification & GNUTLS_CERT_EXPIRED)
1062 GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
1063 c_hostname);
1065 if (peer_verification != 0)
1067 if (verify_error_all
1068 || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error)))
1070 emacs_gnutls_deinit (proc);
1071 error ("Certificate validation failed %s, verification code %d",
1072 c_hostname, peer_verification);
1074 else
1076 GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
1077 c_hostname);
1081 /* Up to here the process is the same for X.509 certificates and
1082 OpenPGP keys. From now on X.509 certificates are assumed. This
1083 can be easily extended to work with openpgp keys as well. */
1084 if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
1086 gnutls_x509_crt_t gnutls_verify_cert;
1087 const gnutls_datum_t *gnutls_verify_cert_list;
1088 unsigned int gnutls_verify_cert_list_size;
1090 ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
1091 if (ret < GNUTLS_E_SUCCESS)
1092 return gnutls_make_error (ret);
1094 gnutls_verify_cert_list =
1095 fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
1097 if (gnutls_verify_cert_list == NULL)
1099 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1100 emacs_gnutls_deinit (proc);
1101 error ("No x509 certificate was found\n");
1104 /* We only check the first certificate in the given chain. */
1105 ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
1106 &gnutls_verify_cert_list[0],
1107 GNUTLS_X509_FMT_DER);
1109 if (ret < GNUTLS_E_SUCCESS)
1111 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1112 return gnutls_make_error (ret);
1115 int err
1116 = fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname);
1117 check_memory_full (err);
1118 if (!err)
1120 if (verify_error_all
1121 || !NILP (Fmember (QCgnutls_bootprop_hostname, verify_error)))
1123 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1124 emacs_gnutls_deinit (proc);
1125 error ("The x509 certificate does not match \"%s\"", c_hostname);
1127 else
1129 GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
1130 c_hostname);
1133 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1136 /* Set this flag only if the whole initialization succeeded. */
1137 XPROCESS (proc)->gnutls_p = 1;
1139 return gnutls_make_error (ret);
1142 DEFUN ("gnutls-bye", Fgnutls_bye,
1143 Sgnutls_bye, 2, 2, 0,
1144 doc: /* Terminate current GnuTLS connection for process PROC.
1145 The connection should have been initiated using `gnutls-handshake'.
1147 If CONT is not nil the TLS connection gets terminated and further
1148 receives and sends will be disallowed. If the return value is zero you
1149 may continue using the connection. If CONT is nil, GnuTLS actually
1150 sends an alert containing a close request and waits for the peer to
1151 reply with the same message. In order to reuse the connection you
1152 should wait for an EOF from the peer.
1154 This function may also return `gnutls-e-again', or
1155 `gnutls-e-interrupted'. */)
1156 (Lisp_Object proc, Lisp_Object cont)
1158 gnutls_session_t state;
1159 int ret;
1161 CHECK_PROCESS (proc);
1163 state = XPROCESS (proc)->gnutls_state;
1165 ret = fn_gnutls_bye (state,
1166 NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
1168 return gnutls_make_error (ret);
1171 #endif /* HAVE_GNUTLS */
1173 DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
1174 doc: /* Return t if GnuTLS is available in this instance of Emacs. */)
1175 (void)
1177 #ifdef HAVE_GNUTLS
1178 # ifdef WINDOWSNT
1179 Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
1180 if (CONSP (found))
1181 return XCDR (found);
1182 else
1184 Lisp_Object status;
1185 status = init_gnutls_functions () ? Qt : Qnil;
1186 Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
1187 return status;
1189 # else /* !WINDOWSNT */
1190 return Qt;
1191 # endif /* !WINDOWSNT */
1192 #else /* !HAVE_GNUTLS */
1193 return Qnil;
1194 #endif /* !HAVE_GNUTLS */
1197 void
1198 syms_of_gnutls (void)
1200 #ifdef HAVE_GNUTLS
1201 gnutls_global_initialized = 0;
1203 DEFSYM (Qgnutls_dll, "gnutls");
1204 DEFSYM (Qgnutls_code, "gnutls-code");
1205 DEFSYM (Qgnutls_anon, "gnutls-anon");
1206 DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
1207 DEFSYM (QCgnutls_bootprop_hostname, ":hostname");
1208 DEFSYM (QCgnutls_bootprop_priority, ":priority");
1209 DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles");
1210 DEFSYM (QCgnutls_bootprop_keylist, ":keylist");
1211 DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
1212 DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks");
1213 DEFSYM (QCgnutls_bootprop_callbacks_verify, "verify");
1214 DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
1215 DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
1216 DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");
1217 DEFSYM (QCgnutls_bootprop_verify_error, ":verify-error");
1219 DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
1220 Fput (Qgnutls_e_interrupted, Qgnutls_code,
1221 make_number (GNUTLS_E_INTERRUPTED));
1223 DEFSYM (Qgnutls_e_again, "gnutls-e-again");
1224 Fput (Qgnutls_e_again, Qgnutls_code,
1225 make_number (GNUTLS_E_AGAIN));
1227 DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session");
1228 Fput (Qgnutls_e_invalid_session, Qgnutls_code,
1229 make_number (GNUTLS_E_INVALID_SESSION));
1231 DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake");
1232 Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code,
1233 make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
1235 defsubr (&Sgnutls_get_initstage);
1236 defsubr (&Sgnutls_errorp);
1237 defsubr (&Sgnutls_error_fatalp);
1238 defsubr (&Sgnutls_error_string);
1239 defsubr (&Sgnutls_boot);
1240 defsubr (&Sgnutls_deinit);
1241 defsubr (&Sgnutls_bye);
1243 DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
1244 doc: /* Logging level used by the GnuTLS functions.
1245 Set this larger than 0 to get debug output in the *Messages* buffer.
1246 1 is for important messages, 2 is for debug data, and higher numbers
1247 are as per the GnuTLS logging conventions. */);
1248 global_gnutls_log_level = 0;
1250 #endif /* HAVE_GNUTLS */
1252 defsubr (&Sgnutls_available_p);