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 EMACS_INT
 332 emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, EMACS_INT nbyte)
 333 {
 334   ssize_t rtnval = 0;
 335   EMACS_INT 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 EMACS_INT
 372 emacs_gnutls_read (struct Lisp_Process *proc, char *buf, EMACS_INT 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 (!NUMBERP (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 (!NUMBERP (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   if (NUMBERP (loglevel))
 755     {
 756       fn_gnutls_global_set_log_function (gnutls_log_function);
 757       fn_gnutls_global_set_log_level (XINT (loglevel));
 758       max_log_level = XINT (loglevel);
 759       XPROCESS (proc)->gnutls_log_level = max_log_level;
 760     }
 761
 762   /* always initialize globals.  */
 763   global_init = emacs_gnutls_global_init ();
 764   if (! NILP (Fgnutls_errorp (global_init)))
 765     return global_init;
 766
 767   /* Before allocating new credentials, deallocate any credentials
 768      that PROC might already have.  */
 769   emacs_gnutls_deinit (proc);
 770
 771   /* Mark PROC as a GnuTLS process.  */
 772   XPROCESS (proc)->gnutls_p = 1;
 773   XPROCESS (proc)->gnutls_state = NULL;
 774   XPROCESS (proc)->gnutls_x509_cred = NULL;
 775   XPROCESS (proc)->gnutls_anon_cred = NULL;
 776   XPROCESS (proc)->gnutls_cred_type = type;
 777   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
 778
 779   GNUTLS_LOG (1, max_log_level, "allocating credentials");
 780   if (EQ (type, Qgnutls_x509pki))
 781     {
 782       Lisp_Object verify_flags;
 783       unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
 784
 785       GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
 786       fn_gnutls_certificate_allocate_credentials (&x509_cred);
 787       XPROCESS (proc)->gnutls_x509_cred = x509_cred;
 788
 789       verify_flags = Fplist_get (proplist, QCgnutls_bootprop_verify_flags);
 790       if (NUMBERP (verify_flags))
 791         {
 792           gnutls_verify_flags = XINT (verify_flags);
 793           GNUTLS_LOG (2, max_log_level, "setting verification flags");
 794         }
 795       else if (NILP (verify_flags))
 796         GNUTLS_LOG (2, max_log_level, "using default verification flags");
 797       else
 798         GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
 799
 800       fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
 801     }
 802   else /* Qgnutls_anon: */
 803     {
 804       GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
 805       fn_gnutls_anon_allocate_client_credentials (&anon_cred);
 806       XPROCESS (proc)->gnutls_anon_cred = anon_cred;
 807     }
 808
 809   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
 810
 811   if (EQ (type, Qgnutls_x509pki))
 812     {
 813       /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
 814       int file_format = GNUTLS_X509_FMT_PEM;
 815       Lisp_Object tail;
 816
 817       for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
 818         {
 819           Lisp_Object trustfile = Fcar (tail);
 820           if (STRINGP (trustfile))
 821             {
 822               GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
 823                            SSDATA (trustfile));
 824               ret = fn_gnutls_certificate_set_x509_trust_file
 825                 (x509_cred,
 826                  SSDATA (trustfile),
 827                  file_format);
 828
 829               if (ret < GNUTLS_E_SUCCESS)
 830                 return gnutls_make_error (ret);
 831             }
 832           else
 833             {
 834               emacs_gnutls_deinit (proc);
 835               error ("Invalid trustfile");
 836             }
 837         }
 838
 839       for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
 840         {
 841           Lisp_Object crlfile = Fcar (tail);
 842           if (STRINGP (crlfile))
 843             {
 844               GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
 845                            SSDATA (crlfile));
 846               ret = fn_gnutls_certificate_set_x509_crl_file
 847                 (x509_cred, SSDATA (crlfile), file_format);
 848
 849               if (ret < GNUTLS_E_SUCCESS)
 850                 return gnutls_make_error (ret);
 851             }
 852           else
 853             {
 854               emacs_gnutls_deinit (proc);
 855               error ("Invalid CRL file");
 856             }
 857         }
 858
 859       for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
 860         {
 861           Lisp_Object keyfile = Fcar (Fcar (tail));
 862           Lisp_Object certfile = Fcar (Fcdr (tail));
 863           if (STRINGP (keyfile) && STRINGP (certfile))
 864             {
 865               GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
 866                            SSDATA (keyfile));
 867               GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
 868                            SSDATA (certfile));
 869               ret = fn_gnutls_certificate_set_x509_key_file
 870                 (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
 871
 872               if (ret < GNUTLS_E_SUCCESS)
 873                 return gnutls_make_error (ret);
 874             }
 875           else
 876             {
 877               emacs_gnutls_deinit (proc);
 878               error (STRINGP (keyfile) ? "Invalid client cert file"
 879                      : "Invalid client key file");
 880             }
 881         }
 882     }
 883
 884   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 885   GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
 886   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
 887
 888   /* Call gnutls_init here: */
 889
 890   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 891   ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
 892   XPROCESS (proc)->gnutls_state = state;
 893   if (ret < GNUTLS_E_SUCCESS)
 894     return gnutls_make_error (ret);
 895   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
 896
 897   if (STRINGP (priority_string))
 898     {
 899       priority_string_ptr = SSDATA (priority_string);
 900       GNUTLS_LOG2 (1, max_log_level, "got non-default priority string:",
 901                    priority_string_ptr);
 902     }
 903   else
 904     {
 905       GNUTLS_LOG2 (1, max_log_level, "using default priority string:",
 906                    priority_string_ptr);
 907     }
 908
 909   GNUTLS_LOG (1, max_log_level, "setting the priority string");
 910   ret = fn_gnutls_priority_set_direct (state,
 911                                        priority_string_ptr,
 912                                        NULL);
 913   if (ret < GNUTLS_E_SUCCESS)
 914     return gnutls_make_error (ret);
 915
 916   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
 917
 918   if (INTEGERP (prime_bits))
 919     fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
 920
 921   ret = EQ (type, Qgnutls_x509pki)
 922     ? fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred)
 923     : fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
 924   if (ret < GNUTLS_E_SUCCESS)
 925     return gnutls_make_error (ret);
 926
 927   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 928   ret = emacs_gnutls_handshake (XPROCESS (proc));
 929   if (ret < GNUTLS_E_SUCCESS)
 930     return gnutls_make_error (ret);
 931
 932   /* Now verify the peer, following
 933      http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
 934      The peer should present at least one certificate in the chain; do a
 935      check of the certificate's hostname with
 936      gnutls_x509_crt_check_hostname() against :hostname.  */
 937
 938   ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
 939   if (ret < GNUTLS_E_SUCCESS)
 940     return gnutls_make_error (ret);
 941
 942   if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
 943     message ("%s certificate could not be verified.", c_hostname);
 944
 945   if (peer_verification & GNUTLS_CERT_REVOKED)
 946     GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
 947                  c_hostname);
 948
 949   if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
 950     GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
 951                  c_hostname);
 952
 953   if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
 954     GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
 955                  c_hostname);
 956
 957   if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
 958     GNUTLS_LOG2 (1, max_log_level,
 959                  "certificate was signed with an insecure algorithm:",
 960                  c_hostname);
 961
 962   if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
 963     GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
 964                  c_hostname);
 965
 966   if (peer_verification & GNUTLS_CERT_EXPIRED)
 967     GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
 968                  c_hostname);
 969
 970   if (peer_verification != 0)
 971     {
 972       if (NILP (verify_hostname_error))
 973         GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
 974                      c_hostname);
 975       else
 976         {
 977           emacs_gnutls_deinit (proc);
 978           error ("Certificate validation failed %s, verification code %d",
 979                  c_hostname, peer_verification);
 980         }
 981     }
 982
 983   /* Up to here the process is the same for X.509 certificates and
 984      OpenPGP keys.  From now on X.509 certificates are assumed.  This
 985      can be easily extended to work with openpgp keys as well.  */
 986   if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
 987     {
 988       gnutls_x509_crt_t gnutls_verify_cert;
 989       const gnutls_datum_t *gnutls_verify_cert_list;
 990       unsigned int gnutls_verify_cert_list_size;
 991
 992       ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
 993       if (ret < GNUTLS_E_SUCCESS)
 994         return gnutls_make_error (ret);
 995
 996       gnutls_verify_cert_list =
 997         fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
 998
 999       if (gnutls_verify_cert_list == NULL)
1000         {
1001           fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1002           emacs_gnutls_deinit (proc);
1003           error ("No x509 certificate was found\n");
1004         }
1005
1006       /* We only check the first certificate in the given chain.  */
1007       ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
1008                                        &gnutls_verify_cert_list[0],
1009                                        GNUTLS_X509_FMT_DER);
1010
1011       if (ret < GNUTLS_E_SUCCESS)
1012         {
1013           fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1014           return gnutls_make_error (ret);
1015         }
1016
1017       if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
1018         {
1019           if (NILP (verify_hostname_error))
1020             GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
1021                          c_hostname);
1022           else
1023             {
1024               fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1025               emacs_gnutls_deinit (proc);
1026               error ("The x509 certificate does not match \"%s\"", c_hostname);
1027             }
1028         }
1029       fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1030     }
1031
1032   return gnutls_make_error (ret);
1033 }
1034
1035 DEFUN ("gnutls-bye", Fgnutls_bye,
1036        Sgnutls_bye, 2, 2, 0,
1037        doc: /* Terminate current GnuTLS connection for process PROC.
1038 The connection should have been initiated using `gnutls-handshake'.
1039
1040 If CONT is not nil the TLS connection gets terminated and further
1041 receives and sends will be disallowed.  If the return value is zero you
1042 may continue using the connection.  If CONT is nil, GnuTLS actually
1043 sends an alert containing a close request and waits for the peer to
1044 reply with the same message.  In order to reuse the connection you
1045 should wait for an EOF from the peer.
1046
1047 This function may also return `gnutls-e-again', or
1048 `gnutls-e-interrupted'.  */)
1049     (Lisp_Object proc, Lisp_Object cont)
1050 {
1051   gnutls_session_t state;
1052   int ret;
1053
1054   CHECK_PROCESS (proc);
1055
1056   state = XPROCESS (proc)->gnutls_state;
1057
1058   ret = fn_gnutls_bye (state,
1059                        NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
1060
1061   return gnutls_make_error (ret);
1062 }
1063
1064 void
1065 syms_of_gnutls (void)
1066 {
1067   gnutls_global_initialized = 0;
1068
1069   DEFSYM (Qgnutls_dll, "gnutls");
1070   DEFSYM (Qgnutls_code, "gnutls-code");
1071   DEFSYM (Qgnutls_anon, "gnutls-anon");
1072   DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
1073   DEFSYM (QCgnutls_bootprop_hostname, ":hostname");
1074   DEFSYM (QCgnutls_bootprop_priority, ":priority");
1075   DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles");
1076   DEFSYM (QCgnutls_bootprop_keylist, ":keylist");
1077   DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
1078   DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks");
1079   DEFSYM (QCgnutls_bootprop_callbacks_verify, "verify");
1080   DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
1081   DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
1082   DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");
1083   DEFSYM (QCgnutls_bootprop_verify_hostname_error, ":verify-hostname-error");
1084
1085   DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
1086   Fput (Qgnutls_e_interrupted, Qgnutls_code,
1087         make_number (GNUTLS_E_INTERRUPTED));
1088
1089   DEFSYM (Qgnutls_e_again, "gnutls-e-again");
1090   Fput (Qgnutls_e_again, Qgnutls_code,
1091         make_number (GNUTLS_E_AGAIN));
1092
1093   DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session");
1094   Fput (Qgnutls_e_invalid_session, Qgnutls_code,
1095         make_number (GNUTLS_E_INVALID_SESSION));
1096
1097   DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake");
1098   Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code,
1099         make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
1100
1101   defsubr (&Sgnutls_get_initstage);
1102   defsubr (&Sgnutls_errorp);
1103   defsubr (&Sgnutls_error_fatalp);
1104   defsubr (&Sgnutls_error_string);
1105   defsubr (&Sgnutls_boot);
1106   defsubr (&Sgnutls_deinit);
1107   defsubr (&Sgnutls_bye);
1108   defsubr (&Sgnutls_available_p);
1109
1110   DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
1111               doc: /* Logging level used by the GnuTLS functions.  */);
1112   global_gnutls_log_level = 0;
1113 }
1114
1115 #endif /* HAVE_GNUTLS */