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