src/gnutls.c

   1 /* GnuTLS glue for GNU Emacs.
   2    Copyright (C) 2010-2011  Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   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.
  10
  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.
  15
  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/>.  */
  18
  19 #include <config.h>
  20 #include <errno.h>
  21 #include <setjmp.h>
  22
  23 #include "lisp.h"
  24 #include "process.h"
  25
  26 #ifdef HAVE_GNUTLS
  27 #include <gnutls/gnutls.h>
  28
  29 #ifdef WINDOWSNT
  30 #include <windows.h>
  31 #include "w32.h"
  32 #endif
  33
  34 static int
  35 emacs_gnutls_handle_error (gnutls_session_t, int err);
  36
  37 static Lisp_Object Qgnutls_dll;
  38 static Lisp_Object Qgnutls_code;
  39 static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
  40 static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
  41   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
  42 static int gnutls_global_initialized;
  43
  44 /* The following are for the property list of `gnutls-boot'.  */
  45 static Lisp_Object QCgnutls_bootprop_priority;
  46 static Lisp_Object QCgnutls_bootprop_trustfiles;
  47 static Lisp_Object QCgnutls_bootprop_keylist;
  48 static Lisp_Object QCgnutls_bootprop_crlfiles;
  49 static Lisp_Object QCgnutls_bootprop_callbacks;
  50 static Lisp_Object QCgnutls_bootprop_loglevel;
  51 static Lisp_Object QCgnutls_bootprop_hostname;
  52 static Lisp_Object QCgnutls_bootprop_min_prime_bits;
  53 static Lisp_Object QCgnutls_bootprop_verify_flags;
  54 static Lisp_Object QCgnutls_bootprop_verify_hostname_error;
  55
  56 /* Callback keys for `gnutls-boot'.  Unused currently.  */
  57 static Lisp_Object QCgnutls_bootprop_callbacks_verify;
  58
  59 static void gnutls_log_function (int, const char *);
  60 static void gnutls_log_function2 (int, const char*, const char*);
  61
  62 \f
  63 #ifdef WINDOWSNT
  64
  65 /* Macro for defining functions that will be loaded from the GnuTLS DLL.  */
  66 #define DEF_GNUTLS_FN(rettype,func,args) static rettype (FAR CDECL *fn_##func)args
  67
  68 /* Macro for loading GnuTLS functions from the library.  */
  69 #define LOAD_GNUTLS_FN(lib,func) {                                      \
  70     fn_##func = (void *) GetProcAddress (lib, #func);                   \
  71     if (!fn_##func) return 0;                                           \
  72   }
  73
  74 DEF_GNUTLS_FN (gnutls_alert_description_t, gnutls_alert_get,
  75                (gnutls_session_t));
  76 DEF_GNUTLS_FN (const char *, gnutls_alert_get_name,
  77                (gnutls_alert_description_t));
  78 DEF_GNUTLS_FN (int, gnutls_alert_send_appropriate, (gnutls_session_t, int));
  79 DEF_GNUTLS_FN (int, gnutls_anon_allocate_client_credentials,
  80                (gnutls_anon_client_credentials_t *));
  81 DEF_GNUTLS_FN (void, gnutls_anon_free_client_credentials,
  82                (gnutls_anon_client_credentials_t));
  83 DEF_GNUTLS_FN (int, gnutls_bye, (gnutls_session_t, gnutls_close_request_t));
  84 DEF_GNUTLS_FN (int, gnutls_certificate_allocate_credentials,
  85                (gnutls_certificate_credentials_t *));
  86 DEF_GNUTLS_FN (void, gnutls_certificate_free_credentials,
  87                (gnutls_certificate_credentials_t));
  88 DEF_GNUTLS_FN (const gnutls_datum_t *, gnutls_certificate_get_peers,
  89                (gnutls_session_t, unsigned int *));
  90 DEF_GNUTLS_FN (void, gnutls_certificate_set_verify_flags,
  91                (gnutls_certificate_credentials_t, unsigned int));
  92 DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_crl_file,
  93                (gnutls_certificate_credentials_t, const char *,
  94                 gnutls_x509_crt_fmt_t));
  95 DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_key_file,
  96                (gnutls_certificate_credentials_t, const char *, const char *,
  97                 gnutls_x509_crt_fmt_t));
  98 DEF_GNUTLS_FN (int, gnutls_certificate_set_x509_trust_file,
  99                (gnutls_certificate_credentials_t, const char *,
 100                 gnutls_x509_crt_fmt_t));
 101 DEF_GNUTLS_FN (gnutls_certificate_type_t, gnutls_certificate_type_get,
 102                (gnutls_session_t));
 103 DEF_GNUTLS_FN (int, gnutls_certificate_verify_peers2,
 104                (gnutls_session_t, unsigned int *));
 105 DEF_GNUTLS_FN (int, gnutls_credentials_set,
 106                (gnutls_session_t, gnutls_credentials_type_t, void *));
 107 DEF_GNUTLS_FN (void, gnutls_deinit, (gnutls_session_t));
 108 DEF_GNUTLS_FN (void, gnutls_dh_set_prime_bits,
 109                (gnutls_session_t, unsigned int));
 110 DEF_GNUTLS_FN (int, gnutls_error_is_fatal, (int));
 111 DEF_GNUTLS_FN (int, gnutls_global_init, (void));
 112 DEF_GNUTLS_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
 113 DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
 114 DEF_GNUTLS_FN (void, gnutls_global_set_mem_functions,
 115                (gnutls_alloc_function, gnutls_alloc_function,
 116                 gnutls_is_secure_function, gnutls_realloc_function,
 117                 gnutls_free_function));
 118 DEF_GNUTLS_FN (int, gnutls_handshake, (gnutls_session_t));
 119 DEF_GNUTLS_FN (int, gnutls_init, (gnutls_session_t *, gnutls_connection_end_t));
 120 DEF_GNUTLS_FN (int, gnutls_priority_set_direct,
 121                (gnutls_session_t, const char *, const char **));
 122 DEF_GNUTLS_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
 123 DEF_GNUTLS_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
 124 DEF_GNUTLS_FN (ssize_t, gnutls_record_send,
 125                (gnutls_session_t, const void *, size_t));
 126 DEF_GNUTLS_FN (const char *, gnutls_strerror, (int));
 127 DEF_GNUTLS_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
 128 DEF_GNUTLS_FN (void, gnutls_transport_set_lowat, (gnutls_session_t, int));
 129 DEF_GNUTLS_FN (void, gnutls_transport_set_ptr2,
 130                (gnutls_session_t, gnutls_transport_ptr_t,
 131                 gnutls_transport_ptr_t));
 132 DEF_GNUTLS_FN (void, gnutls_transport_set_pull_function,
 133                (gnutls_session_t, gnutls_pull_func));
 134 DEF_GNUTLS_FN (void, gnutls_transport_set_push_function,
 135                (gnutls_session_t, gnutls_push_func));
 136 DEF_GNUTLS_FN (int, gnutls_x509_crt_check_hostname,
 137                (gnutls_x509_crt_t, const char *));
 138 DEF_GNUTLS_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
 139 DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
 140                (gnutls_x509_crt_t, const gnutls_datum_t *,
 141                 gnutls_x509_crt_fmt_t));
 142 DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
 143
 144 static int
 145 init_gnutls_functions (Lisp_Object libraries)
 146 {
 147   HMODULE library;
 148   int max_log_level = 1;
 149
 150   if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
 151     {
 152       GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
 153       return 0;
 154     }
 155
 156   LOAD_GNUTLS_FN (library, gnutls_alert_get);
 157   LOAD_GNUTLS_FN (library, gnutls_alert_get_name);
 158   LOAD_GNUTLS_FN (library, gnutls_alert_send_appropriate);
 159   LOAD_GNUTLS_FN (library, gnutls_anon_allocate_client_credentials);
 160   LOAD_GNUTLS_FN (library, gnutls_anon_free_client_credentials);
 161   LOAD_GNUTLS_FN (library, gnutls_bye);
 162   LOAD_GNUTLS_FN (library, gnutls_certificate_allocate_credentials);
 163   LOAD_GNUTLS_FN (library, gnutls_certificate_free_credentials);
 164   LOAD_GNUTLS_FN (library, gnutls_certificate_get_peers);
 165   LOAD_GNUTLS_FN (library, gnutls_certificate_set_verify_flags);
 166   LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_crl_file);
 167   LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_key_file);
 168   LOAD_GNUTLS_FN (library, gnutls_certificate_set_x509_trust_file);
 169   LOAD_GNUTLS_FN (library, gnutls_certificate_type_get);
 170   LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
 171   LOAD_GNUTLS_FN (library, gnutls_credentials_set);
 172   LOAD_GNUTLS_FN (library, gnutls_deinit);
 173   LOAD_GNUTLS_FN (library, gnutls_dh_set_prime_bits);
 174   LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
 175   LOAD_GNUTLS_FN (library, gnutls_global_init);
 176   LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
 177   LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
 178   LOAD_GNUTLS_FN (library, gnutls_global_set_mem_functions);
 179   LOAD_GNUTLS_FN (library, gnutls_handshake);
 180   LOAD_GNUTLS_FN (library, gnutls_init);
 181   LOAD_GNUTLS_FN (library, gnutls_priority_set_direct);
 182   LOAD_GNUTLS_FN (library, gnutls_record_check_pending);
 183   LOAD_GNUTLS_FN (library, gnutls_record_recv);
 184   LOAD_GNUTLS_FN (library, gnutls_record_send);
 185   LOAD_GNUTLS_FN (library, gnutls_strerror);
 186   LOAD_GNUTLS_FN (library, gnutls_transport_set_errno);
 187   LOAD_GNUTLS_FN (library, gnutls_transport_set_lowat);
 188   LOAD_GNUTLS_FN (library, gnutls_transport_set_ptr2);
 189   LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
 190   LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
 191   LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
 192   LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
 193   LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
 194   LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
 195
 196   max_log_level = global_gnutls_log_level;
 197
 198   GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
 199                SDATA (Fget (Qgnutls_dll, QCloaded_from)));
 200   return 1;
 201 }
 202
 203 #else /* !WINDOWSNT */
 204
 205 #define fn_gnutls_alert_get                     gnutls_alert_get
 206 #define fn_gnutls_alert_get_name                gnutls_alert_get_name
 207 #define fn_gnutls_alert_send_appropriate        gnutls_alert_send_appropriate
 208 #define fn_gnutls_anon_allocate_client_credentials gnutls_anon_allocate_client_credentials
 209 #define fn_gnutls_anon_free_client_credentials  gnutls_anon_free_client_credentials
 210 #define fn_gnutls_bye                           gnutls_bye
 211 #define fn_gnutls_certificate_allocate_credentials gnutls_certificate_allocate_credentials
 212 #define fn_gnutls_certificate_free_credentials  gnutls_certificate_free_credentials
 213 #define fn_gnutls_certificate_get_peers         gnutls_certificate_get_peers
 214 #define fn_gnutls_certificate_set_verify_flags  gnutls_certificate_set_verify_flags
 215 #define fn_gnutls_certificate_set_x509_crl_file gnutls_certificate_set_x509_crl_file
 216 #define fn_gnutls_certificate_set_x509_key_file gnutls_certificate_set_x509_key_file
 217 #define fn_gnutls_certificate_set_x509_trust_file gnutls_certificate_set_x509_trust_file
 218 #define fn_gnutls_certificate_type_get          gnutls_certificate_type_get
 219 #define fn_gnutls_certificate_verify_peers2     gnutls_certificate_verify_peers2
 220 #define fn_gnutls_credentials_set               gnutls_credentials_set
 221 #define fn_gnutls_deinit                        gnutls_deinit
 222 #define fn_gnutls_dh_set_prime_bits             gnutls_dh_set_prime_bits
 223 #define fn_gnutls_error_is_fatal                gnutls_error_is_fatal
 224 #define fn_gnutls_global_init                   gnutls_global_init
 225 #define fn_gnutls_global_set_log_function       gnutls_global_set_log_function
 226 #define fn_gnutls_global_set_log_level          gnutls_global_set_log_level
 227 #define fn_gnutls_global_set_mem_functions      gnutls_global_set_mem_functions
 228 #define fn_gnutls_handshake                     gnutls_handshake
 229 #define fn_gnutls_init                          gnutls_init
 230 #define fn_gnutls_priority_set_direct           gnutls_priority_set_direct
 231 #define fn_gnutls_record_check_pending          gnutls_record_check_pending
 232 #define fn_gnutls_record_recv                   gnutls_record_recv
 233 #define fn_gnutls_record_send                   gnutls_record_send
 234 #define fn_gnutls_strerror                      gnutls_strerror
 235 #define fn_gnutls_transport_set_errno           gnutls_transport_set_errno
 236 #define fn_gnutls_transport_set_ptr2            gnutls_transport_set_ptr2
 237 #define fn_gnutls_x509_crt_check_hostname       gnutls_x509_crt_check_hostname
 238 #define fn_gnutls_x509_crt_deinit               gnutls_x509_crt_deinit
 239 #define fn_gnutls_x509_crt_import               gnutls_x509_crt_import
 240 #define fn_gnutls_x509_crt_init                 gnutls_x509_crt_init
 241
 242 #endif /* !WINDOWSNT */
 243
 244 \f
 245 static void
 246 gnutls_log_function (int level, const char* string)
 247 {
 248   message ("gnutls.c: [%d] %s", level, string);
 249 }
 250
 251 static void
 252 gnutls_log_function2 (int level, const char* string, const char* extra)
 253 {
 254   message ("gnutls.c: [%d] %s %s", level, string, extra);
 255 }
 256
 257 static int
 258 emacs_gnutls_handshake (struct Lisp_Process *proc)
 259 {
 260   gnutls_session_t state = proc->gnutls_state;
 261   int ret;
 262
 263   if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
 264     return -1;
 265
 266   if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
 267     {
 268 #ifdef WINDOWSNT
 269       /* On W32 we cannot transfer socket handles between different runtime
 270          libraries, so we tell GnuTLS to use our special push/pull
 271          functions.  */
 272       fn_gnutls_transport_set_ptr2 (state,
 273                                     (gnutls_transport_ptr_t) proc,
 274                                     (gnutls_transport_ptr_t) proc);
 275       fn_gnutls_transport_set_push_function (state, &emacs_gnutls_push);
 276       fn_gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
 277
 278       /* For non blocking sockets or other custom made pull/push
 279          functions the gnutls_transport_set_lowat must be called, with
 280          a zero low water mark value. (GnuTLS 2.10.4 documentation)
 281
 282          (Note: this is probably not strictly necessary as the lowat
 283           value is only used when no custom pull/push functions are
 284           set.)  */
 285       fn_gnutls_transport_set_lowat (state, 0);
 286 #else
 287       /* This is how GnuTLS takes sockets: as file descriptors passed
 288          in.  For an Emacs process socket, infd and outfd are the
 289          same but we use this two-argument version for clarity.  */
 290       fn_gnutls_transport_set_ptr2 (state,
 291                                     (gnutls_transport_ptr_t) (long) proc->infd,
 292                                     (gnutls_transport_ptr_t) (long) proc->outfd);
 293 #endif
 294
 295       proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
 296     }
 297
 298   do
 299     {
 300       ret = fn_gnutls_handshake (state);
 301       emacs_gnutls_handle_error (state, ret);
 302     }
 303   while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
 304
 305   proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
 306
 307   if (ret == GNUTLS_E_SUCCESS)
 308     {
 309       /* Here we're finally done.  */
 310       proc->gnutls_initstage = GNUTLS_STAGE_READY;
 311     }
 312   else
 313     {
 314       fn_gnutls_alert_send_appropriate (state, ret);
 315     }
 316   return ret;
 317 }
 318
 319 int
 320 emacs_gnutls_record_check_pending (gnutls_session_t state)
 321 {
 322   return fn_gnutls_record_check_pending (state);
 323 }
 324
 325 void
 326 emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
 327 {
 328   fn_gnutls_transport_set_errno (state, err);
 329 }
 330
 331 ptrdiff_t
 332 emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
 333 {
 334   ssize_t rtnval = 0;
 335   ptrdiff_t bytes_written;
 336   gnutls_session_t state = proc->gnutls_state;
 337
 338   if (proc->gnutls_initstage != GNUTLS_STAGE_READY) {
 339 #ifdef EWOULDBLOCK
 340     errno = EWOULDBLOCK;
 341 #endif
 342 #ifdef EAGAIN
 343     errno = EAGAIN;
 344 #endif
 345     return 0;
 346   }
 347
 348   bytes_written = 0;
 349
 350   while (nbyte > 0)
 351     {
 352       rtnval = fn_gnutls_record_send (state, buf, nbyte);
 353
 354       if (rtnval < 0)
 355         {
 356           if (rtnval == GNUTLS_E_AGAIN || rtnval == GNUTLS_E_INTERRUPTED)
 357             continue;
 358           else
 359             break;
 360         }
 361
 362       buf += rtnval;
 363       nbyte -= rtnval;
 364       bytes_written += rtnval;
 365     }
 366
 367   emacs_gnutls_handle_error (state, rtnval);
 368   return (bytes_written);
 369 }
 370
 371 ptrdiff_t
 372 emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
 373 {
 374   ssize_t rtnval;
 375   gnutls_session_t state = proc->gnutls_state;
 376
 377   if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
 378     {
 379       emacs_gnutls_handshake (proc);
 380       return -1;
 381     }
 382   rtnval = fn_gnutls_record_recv (state, buf, nbyte);
 383   if (rtnval >= 0)
 384     return rtnval;
 385   else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
 386     /* The peer closed the connection. */
 387     return 0;
 388   else if (emacs_gnutls_handle_error (state, rtnval) == 0)
 389     /* non-fatal error */
 390     return -1;
 391   else {
 392     /* a fatal error occurred */
 393     return 0;
 394   }
 395 }
 396
 397 /* report a GnuTLS error to the user.
 398    Returns zero if the error code was successfully handled. */
 399 static int
 400 emacs_gnutls_handle_error (gnutls_session_t session, int err)
 401 {
 402   int max_log_level = 0;
 403
 404   int ret;
 405   const char *str;
 406
 407   /* TODO: use a Lisp_Object generated by gnutls_make_error?  */
 408   if (err >= 0)
 409     return 0;
 410
 411   max_log_level = global_gnutls_log_level;
 412
 413   /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */
 414
 415   str = fn_gnutls_strerror (err);
 416   if (!str)
 417     str = "unknown";
 418
 419   if (fn_gnutls_error_is_fatal (err))
 420     {
 421       ret = err;
 422       GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
 423     }
 424   else
 425     {
 426       ret = 0;
 427       GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
 428       /* TODO: EAGAIN AKA Qgnutls_e_again should be level 2.  */
 429     }
 430
 431   if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
 432       || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
 433     {
 434       int alert = fn_gnutls_alert_get (session);
 435       int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
 436       str = fn_gnutls_alert_get_name (alert);
 437       if (!str)
 438         str = "unknown";
 439
 440       GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str);
 441     }
 442   return ret;
 443 }
 444
 445 /* convert an integer error to a Lisp_Object; it will be either a
 446    known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or
 447    simply the integer value of the error.  GNUTLS_E_SUCCESS is mapped
 448    to Qt.  */
 449 static Lisp_Object
 450 gnutls_make_error (int err)
 451 {
 452   switch (err)
 453     {
 454     case GNUTLS_E_SUCCESS:
 455       return Qt;
 456     case GNUTLS_E_AGAIN:
 457       return Qgnutls_e_again;
 458     case GNUTLS_E_INTERRUPTED:
 459       return Qgnutls_e_interrupted;
 460     case GNUTLS_E_INVALID_SESSION:
 461       return Qgnutls_e_invalid_session;
 462     }
 463
 464   return make_number (err);
 465 }
 466
 467 Lisp_Object
 468 emacs_gnutls_deinit (Lisp_Object proc)
 469 {
 470   int log_level;
 471
 472   CHECK_PROCESS (proc);
 473
 474   if (XPROCESS (proc)->gnutls_p == 0)
 475     return Qnil;
 476
 477   log_level = XPROCESS (proc)->gnutls_log_level;
 478
 479   if (XPROCESS (proc)->gnutls_x509_cred)
 480     {
 481       GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
 482       fn_gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
 483       XPROCESS (proc)->gnutls_x509_cred = NULL;
 484     }
 485
 486   if (XPROCESS (proc)->gnutls_anon_cred)
 487     {
 488       GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
 489       fn_gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
 490       XPROCESS (proc)->gnutls_anon_cred = NULL;
 491     }
 492
 493   if (XPROCESS (proc)->gnutls_state)
 494     {
 495       fn_gnutls_deinit (XPROCESS (proc)->gnutls_state);
 496       XPROCESS (proc)->gnutls_state = NULL;
 497       if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
 498         GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
 499     }
 500
 501   XPROCESS (proc)->gnutls_p = 0;
 502   return Qt;
 503 }
 504
 505 DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
 506        doc: /* Return the GnuTLS init stage of process PROC.
 507 See also `gnutls-boot'.  */)
 508   (Lisp_Object proc)
 509 {
 510   CHECK_PROCESS (proc);
 511
 512   return make_number (GNUTLS_INITSTAGE (proc));
 513 }
 514
 515 DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
 516        doc: /* Return t if ERROR indicates a GnuTLS problem.
 517 ERROR is an integer or a symbol with an integer `gnutls-code' property.
 518 usage: (gnutls-errorp ERROR)  */)
 519   (Lisp_Object err)
 520 {
 521   if (EQ (err, Qt)) return Qnil;
 522
 523   return Qt;
 524 }
 525
 526 DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0,
 527        doc: /* Check if ERROR is fatal.
 528 ERROR is an integer or a symbol with an integer `gnutls-code' property.
 529 usage: (gnutls-error-fatalp ERROR)  */)
 530   (Lisp_Object err)
 531 {
 532   Lisp_Object code;
 533
 534   if (EQ (err, Qt)) return Qnil;
 535
 536   if (SYMBOLP (err))
 537     {
 538       code = Fget (err, Qgnutls_code);
 539       if (NUMBERP (code))
 540         {
 541           err = code;
 542         }
 543       else
 544         {
 545           error ("Symbol has no numeric gnutls-code property");
 546         }
 547     }
 548
 549   if (! TYPE_RANGED_INTEGERP (int, err))
 550     error ("Not an error symbol or code");
 551
 552   if (0 == fn_gnutls_error_is_fatal (XINT (err)))
 553     return Qnil;
 554
 555   return Qt;
 556 }
 557
 558 DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0,
 559        doc: /* Return a description of ERROR.
 560 ERROR is an integer or a symbol with an integer `gnutls-code' property.
 561 usage: (gnutls-error-string ERROR)  */)
 562   (Lisp_Object err)
 563 {
 564   Lisp_Object code;
 565
 566   if (EQ (err, Qt)) return build_string ("Not an error");
 567
 568   if (SYMBOLP (err))
 569     {
 570       code = Fget (err, Qgnutls_code);
 571       if (NUMBERP (code))
 572         {
 573           err = code;
 574         }
 575       else
 576         {
 577           return build_string ("Symbol has no numeric gnutls-code property");
 578         }
 579     }
 580
 581   if (! TYPE_RANGED_INTEGERP (int, err))
 582     return build_string ("Not an error symbol or code");
 583
 584   return build_string (fn_gnutls_strerror (XINT (err)));
 585 }
 586
 587 DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
 588        doc: /* Deallocate GnuTLS resources associated with process PROC.
 589 See also `gnutls-init'.  */)
 590   (Lisp_Object proc)
 591 {
 592   return emacs_gnutls_deinit (proc);
 593 }
 594
 595 DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
 596        doc: /* Return t if GnuTLS is available in this instance of Emacs.  */)
 597      (void)
 598 {
 599 #ifdef WINDOWSNT
 600   Lisp_Object found = Fassq (Qgnutls_dll, Vlibrary_cache);
 601   if (CONSP (found))
 602     return XCDR (found);
 603   else
 604     {
 605       Lisp_Object status;
 606       status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
 607       Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
 608       return status;
 609     }
 610 #else
 611   return Qt;
 612 #endif
 613 }
 614
 615
 616 /* Initializes global GnuTLS state to defaults.
 617 Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
 618 Returns zero on success.  */
 619 static Lisp_Object
 620 emacs_gnutls_global_init (void)
 621 {
 622   int ret = GNUTLS_E_SUCCESS;
 623
 624   if (!gnutls_global_initialized)
 625     {
 626       fn_gnutls_global_set_mem_functions (xmalloc, xmalloc, NULL,
 627                                           xrealloc, xfree);
 628       ret = fn_gnutls_global_init ();
 629     }
 630   gnutls_global_initialized = 1;
 631
 632   return gnutls_make_error (ret);
 633 }
 634
 635 #if 0
 636 /* Deinitializes global GnuTLS state.
 637 See also `gnutls-global-init'.  */
 638 static Lisp_Object
 639 emacs_gnutls_global_deinit (void)
 640 {
 641   if (gnutls_global_initialized)
 642     gnutls_global_deinit ();
 643
 644   gnutls_global_initialized = 0;
 645
 646   return gnutls_make_error (GNUTLS_E_SUCCESS);
 647 }
 648 #endif
 649
 650 DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
 651        doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
 652 Currently only client mode is supported.  Return a success/failure
 653 value you can check with `gnutls-errorp'.
 654
 655 TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
 656 PROPLIST is a property list with the following keys:
 657
 658 :hostname is a string naming the remote host.
 659
 660 :priority is a GnuTLS priority string, defaults to "NORMAL".
 661
 662 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
 663
 664 :crlfiles is a list of PEM-encoded CRL lists for `gnutls-x509pki'.
 665
 666 :keylist is an alist of PEM-encoded key files and PEM-encoded
 667 certificates for `gnutls-x509pki'.
 668
 669 :callbacks is an alist of callback functions, see below.
 670
 671 :loglevel is the debug level requested from GnuTLS, try 4.
 672
 673 :verify-flags is a bitset as per GnuTLS'
 674 gnutls_certificate_set_verify_flags.
 675
 676 :verify-hostname-error, if non-nil, makes a hostname mismatch an
 677 error.  Otherwise it will be just a warning.
 678
 679 :min-prime-bits is the minimum accepted number of bits the client will
 680 accept in Diffie-Hellman key exchange.
 681
 682 The debug level will be set for this process AND globally for GnuTLS.
 683 So if you set it higher or lower at any point, it affects global
 684 debugging.
 685
 686 Note that the priority is set on the client.  The server does not use
 687 the protocols's priority except for disabling protocols that were not
 688 specified.
 689
 690 Processes must be initialized with this function before other GnuTLS
 691 functions are used.  This function allocates resources which can only
 692 be deallocated by calling `gnutls-deinit' or by calling it again.
 693
 694 The callbacks alist can have a `verify' key, associated with a
 695 verification function (UNUSED).
 696
 697 Each authentication type may need additional information in order to
 698 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 699 one trustfile (usually a CA bundle).  */)
 700   (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
 701 {
 702   int ret = GNUTLS_E_SUCCESS;
 703   int max_log_level = 0;
 704
 705   gnutls_session_t state;
 706   gnutls_certificate_credentials_t x509_cred = NULL;
 707   gnutls_anon_client_credentials_t anon_cred = NULL;
 708   Lisp_Object global_init;
 709   char const *priority_string_ptr = "NORMAL"; /* default priority string.  */
 710   unsigned int peer_verification;
 711   char* c_hostname;
 712
 713   /* Placeholders for the property list elements.  */
 714   Lisp_Object priority_string;
 715   Lisp_Object trustfiles;
 716   Lisp_Object crlfiles;
 717   Lisp_Object keylist;
 718   /* Lisp_Object callbacks; */
 719   Lisp_Object loglevel;
 720   Lisp_Object hostname;
 721   /* Lisp_Object verify_error; */
 722   Lisp_Object verify_hostname_error;
 723   Lisp_Object prime_bits;
 724
 725   CHECK_PROCESS (proc);
 726   CHECK_SYMBOL (type);
 727   CHECK_LIST (proplist);
 728
 729   if (NILP (Fgnutls_available_p ()))
 730     {
 731       error ("GnuTLS not available");
 732       return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
 733     }
 734
 735   if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
 736     {
 737       error ("Invalid GnuTLS credential type");
 738       return gnutls_make_error (GNUTLS_EMACS_ERROR_INVALID_TYPE);
 739     }
 740
 741   hostname              = Fplist_get (proplist, QCgnutls_bootprop_hostname);
 742   priority_string       = Fplist_get (proplist, QCgnutls_bootprop_priority);
 743   trustfiles            = Fplist_get (proplist, QCgnutls_bootprop_trustfiles);
 744   keylist               = Fplist_get (proplist, QCgnutls_bootprop_keylist);
 745   crlfiles              = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);
 746   loglevel              = Fplist_get (proplist, QCgnutls_bootprop_loglevel);
 747   verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error);
 748   prime_bits            = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);
 749
 750   if (!STRINGP (hostname))
 751     error ("gnutls-boot: invalid :hostname parameter");
 752   c_hostname = SSDATA (hostname);
 753
 754   state = XPROCESS (proc)->gnutls_state;
 755   XPROCESS (proc)->gnutls_p = 1;
 756
 757   if (TYPE_RANGED_INTEGERP (int, loglevel))
 758     {
 759       fn_gnutls_global_set_log_function (gnutls_log_function);
 760       fn_gnutls_global_set_log_level (XINT (loglevel));
 761       max_log_level = XINT (loglevel);
 762       XPROCESS (proc)->gnutls_log_level = max_log_level;
 763     }
 764
 765   /* always initialize globals.  */
 766   global_init = emacs_gnutls_global_init ();
 767   if (! NILP (Fgnutls_errorp (global_init)))
 768     return global_init;
 769
 770   /* Before allocating new credentials, deallocate any credentials
 771      that PROC might already have.  */
 772   emacs_gnutls_deinit (proc);
 773
 774   /* Mark PROC as a GnuTLS process.  */
 775   XPROCESS (proc)->gnutls_p = 1;
 776   XPROCESS (proc)->gnutls_state = NULL;
 777   XPROCESS (proc)->gnutls_x509_cred = NULL;
 778   XPROCESS (proc)->gnutls_anon_cred = NULL;
 779   XPROCESS (proc)->gnutls_cred_type = type;
 780   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
 781
 782   GNUTLS_LOG (1, max_log_level, "allocating credentials");
 783   if (EQ (type, Qgnutls_x509pki))
 784     {
 785       Lisp_Object verify_flags;
 786       unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
 787
 788       GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
 789       fn_gnutls_certificate_allocate_credentials (&x509_cred);
 790       XPROCESS (proc)->gnutls_x509_cred = x509_cred;
 791
 792       verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
 793       if (NUMBERP (verify_flags))
 794         {
 795           gnutls_verify_flags = XINT (verify_flags);
 796           GNUTLS_LOG (2, max_log_level, "setting verification flags");
 797         }
 798       else if (NILP (verify_flags))
 799         GNUTLS_LOG (2, max_log_level, "using default verification flags");
 800       else
 801         GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
 802
 803       fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
 804     }
 805   else /* Qgnutls_anon: */
 806     {
 807       GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
 808       fn_gnutls_anon_allocate_client_credentials (&anon_cred);
 809       XPROCESS (proc)->gnutls_anon_cred = anon_cred;
 810     }
 811
 812   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
 813
 814   if (EQ (type, Qgnutls_x509pki))
 815     {
 816       /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
 817       int file_format = GNUTLS_X509_FMT_PEM;
 818       Lisp_Object tail;
 819
 820       for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
 821         {
 822           Lisp_Object trustfile = Fcar (tail);
 823           if (STRINGP (trustfile))
 824             {
 825               GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
 826                            SSDATA (trustfile));
 827               ret = fn_gnutls_certificate_set_x509_trust_file
 828                 (x509_cred,
 829                  SSDATA (trustfile),
 830                  file_format);
 831
 832               if (ret < GNUTLS_E_SUCCESS)
 833                 return gnutls_make_error (ret);
 834             }
 835           else
 836             {
 837               emacs_gnutls_deinit (proc);
 838               error ("Invalid trustfile");
 839             }
 840         }
 841
 842       for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
 843         {
 844           Lisp_Object crlfile = Fcar (tail);
 845           if (STRINGP (crlfile))
 846             {
 847               GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
 848                            SSDATA (crlfile));
 849               ret = fn_gnutls_certificate_set_x509_crl_file
 850                 (x509_cred, SSDATA (crlfile), file_format);
 851
 852               if (ret < GNUTLS_E_SUCCESS)
 853                 return gnutls_make_error (ret);
 854             }
 855           else
 856             {
 857               emacs_gnutls_deinit (proc);
 858               error ("Invalid CRL file");
 859             }
 860         }
 861
 862       for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
 863         {
 864           Lisp_Object keyfile = Fcar (Fcar (tail));
 865           Lisp_Object certfile = Fcar (Fcdr (tail));
 866           if (STRINGP (keyfile) && STRINGP (certfile))
 867             {
 868               GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
 869                            SSDATA (keyfile));
 870               GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
 871                            SSDATA (certfile));
 872               ret = fn_gnutls_certificate_set_x509_key_file
 873                 (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
 874
 875               if (ret < GNUTLS_E_SUCCESS)
 876                 return gnutls_make_error (ret);
 877             }
 878           else
 879             {
 880               emacs_gnutls_deinit (proc);
 881               error (STRINGP (keyfile) ? "Invalid client cert file"
 882                      : "Invalid client key file");
 883             }
 884         }
 885     }
 886
 887   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 888   GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
 889   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
 890
 891   /* Call gnutls_init here: */
 892
 893   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 894   ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
 895   XPROCESS (proc)->gnutls_state = state;
 896   if (ret < GNUTLS_E_SUCCESS)
 897     return gnutls_make_error (ret);
 898   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
 899
 900   if (STRINGP (priority_string))
 901     {
 902       priority_string_ptr = SSDATA (priority_string);
 903       GNUTLS_LOG2 (1, max_log_level, "got non-default priority string:",
 904                    priority_string_ptr);
 905     }
 906   else
 907     {
 908       GNUTLS_LOG2 (1, max_log_level, "using default priority string:",
 909                    priority_string_ptr);
 910     }
 911
 912   GNUTLS_LOG (1, max_log_level, "setting the priority string");
 913   ret = fn_gnutls_priority_set_direct (state,
 914                                        priority_string_ptr,
 915                                        NULL);
 916   if (ret < GNUTLS_E_SUCCESS)
 917     return gnutls_make_error (ret);
 918
 919   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
 920
 921   if (INTEGERP (prime_bits))
 922     fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
 923
 924   ret = EQ (type, Qgnutls_x509pki)
 925     ? fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
 926     : fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
 927   if (ret < GNUTLS_E_SUCCESS)
 928     return gnutls_make_error (ret);
 929
 930   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 931   ret = emacs_gnutls_handshake (XPROCESS (proc));
 932   if (ret < GNUTLS_E_SUCCESS)
 933     return gnutls_make_error (ret);
 934
 935   /* Now verify the peer, following
 936      http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
 937      The peer should present at least one certificate in the chain; do a
 938      check of the certificate's hostname with
 939      gnutls_x509_crt_check_hostname() against :hostname.  */
 940
 941   ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
 942   if (ret < GNUTLS_E_SUCCESS)
 943     return gnutls_make_error (ret);
 944
 945   if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
 946     message ("%s certificate could not be verified.", c_hostname);
 947
 948   if (peer_verification & GNUTLS_CERT_REVOKED)
 949     GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
 950                  c_hostname);
 951
 952   if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
 953     GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
 954                  c_hostname);
 955
 956   if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
 957     GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
 958                  c_hostname);
 959
 960   if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
 961     GNUTLS_LOG2 (1, max_log_level,
 962                  "certificate was signed with an insecure algorithm:",
 963                  c_hostname);
 964
 965   if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
 966     GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
 967                  c_hostname);
 968
 969   if (peer_verification & GNUTLS_CERT_EXPIRED)
 970     GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
 971                  c_hostname);
 972
 973   if (peer_verification != 0)
 974     {
 975       if (NILP (verify_hostname_error))
 976         GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
 977                      c_hostname);
 978       else
 979         {
 980           emacs_gnutls_deinit (proc);
 981           error ("Certificate validation failed %s, verification code %d",
 982                  c_hostname, peer_verification);
 983         }
 984     }
 985
 986   /* Up to here the process is the same for X.509 certificates and
 987      OpenPGP keys.  From now on X.509 certificates are assumed.  This
 988      can be easily extended to work with openpgp keys as well.  */
 989   if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
 990     {
 991       gnutls_x509_crt_t gnutls_verify_cert;
 992       const gnutls_datum_t *gnutls_verify_cert_list;
 993       unsigned int gnutls_verify_cert_list_size;
 994
 995       ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
 996       if (ret < GNUTLS_E_SUCCESS)
 997         return gnutls_make_error (ret);
 998
 999       gnutls_verify_cert_list =
1000         fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
1001
1002       if (gnutls_verify_cert_list == NULL)
1003         {
1004           fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1005           emacs_gnutls_deinit (proc);
1006           error ("No x509 certificate was found\n");
1007         }
1008
1009       /* We only check the first certificate in the given chain.  */
1010       ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
1011                                        &gnutls_verify_cert_list[0],
1012                                        GNUTLS_X509_FMT_DER);
1013
1014       if (ret < GNUTLS_E_SUCCESS)
1015         {
1016           fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1017           return gnutls_make_error (ret);
1018         }
1019
1020       if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
1021         {
1022           if (NILP (verify_hostname_error))
1023             GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
1024                          c_hostname);
1025           else
1026             {
1027               fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1028               emacs_gnutls_deinit (proc);
1029               error ("The x509 certificate does not match \"%s\"", c_hostname);
1030             }
1031         }
1032       fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1033     }
1034
1035   return gnutls_make_error (ret);
1036 }
1037
1038 DEFUN ("gnutls-bye", Fgnutls_bye,
1039        Sgnutls_bye, 2, 2, 0,
1040        doc: /* Terminate current GnuTLS connection for process PROC.
1041 The connection should have been initiated using `gnutls-handshake'.
1042
1043 If CONT is not nil the TLS connection gets terminated and further
1044 receives and sends will be disallowed.  If the return value is zero you
1045 may continue using the connection.  If CONT is nil, GnuTLS actually
1046 sends an alert containing a close request and waits for the peer to
1047 reply with the same message.  In order to reuse the connection you
1048 should wait for an EOF from the peer.
1049
1050 This function may also return `gnutls-e-again', or
1051 `gnutls-e-interrupted'.  */)
1052     (Lisp_Object proc, Lisp_Object cont)
1053 {
1054   gnutls_session_t state;
1055   int ret;
1056
1057   CHECK_PROCESS (proc);
1058
1059   state = XPROCESS (proc)->gnutls_state;
1060
1061   ret = fn_gnutls_bye (state,
1062                        NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
1063
1064   return gnutls_make_error (ret);
1065 }
1066
1067 void
1068 syms_of_gnutls (void)
1069 {
1070   gnutls_global_initialized = 0;
1071
1072   DEFSYM (Qgnutls_dll, "gnutls");
1073   DEFSYM (Qgnutls_code, "gnutls-code");
1074   DEFSYM (Qgnutls_anon, "gnutls-anon");
1075   DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
1076   DEFSYM (QCgnutls_bootprop_hostname, ":hostname");
1077   DEFSYM (QCgnutls_bootprop_priority, ":priority");
1078   DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles");
1079   DEFSYM (QCgnutls_bootprop_keylist, ":keylist");
1080   DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
1081   DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks");
1082   DEFSYM (QCgnutls_bootprop_callbacks_verify, "verify");
1083   DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
1084   DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
1085   DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");
1086   DEFSYM (QCgnutls_bootprop_verify_hostname_error, ":verify-hostname-error");
1087
1088   DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
1089   Fput (Qgnutls_e_interrupted, Qgnutls_code,
1090         make_number (GNUTLS_E_INTERRUPTED));
1091
1092   DEFSYM (Qgnutls_e_again, "gnutls-e-again");
1093   Fput (Qgnutls_e_again, Qgnutls_code,
1094         make_number (GNUTLS_E_AGAIN));
1095
1096   DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session");
1097   Fput (Qgnutls_e_invalid_session, Qgnutls_code,
1098         make_number (GNUTLS_E_INVALID_SESSION));
1099
1100   DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake");
1101   Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code,
1102         make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
1103
1104   defsubr (&Sgnutls_get_initstage);
1105   defsubr (&Sgnutls_errorp);
1106   defsubr (&Sgnutls_error_fatalp);
1107   defsubr (&Sgnutls_error_string);
1108   defsubr (&Sgnutls_boot);
1109   defsubr (&Sgnutls_deinit);
1110   defsubr (&Sgnutls_bye);
1111   defsubr (&Sgnutls_available_p);
1112
1113   DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
1114               doc: /* Logging level used by the GnuTLS functions.  */);
1115   global_gnutls_log_level = 0;
1116 }
1117
1118 #endif /* HAVE_GNUTLS */