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