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 Qgnutls_bootprop_priority;
  46 static Lisp_Object Qgnutls_bootprop_trustfiles;
  47 static Lisp_Object Qgnutls_bootprop_keylist;
  48 static Lisp_Object Qgnutls_bootprop_crlfiles;
  49 static Lisp_Object Qgnutls_bootprop_callbacks;
  50 static Lisp_Object Qgnutls_bootprop_loglevel;
  51 static Lisp_Object Qgnutls_bootprop_hostname;
  52 static Lisp_Object Qgnutls_bootprop_min_prime_bits;
  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 (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 (emacs_gnutls_handle_error (state, rtnval) == 0)
 386     /* non-fatal error */
 387     return -1;
 388   else {
 389     /* a fatal error occurred */
 390     return 0;
 391   }
 392 }
 393
 394 /* report a GnuTLS error to the user.
 395    Returns zero if the error code was successfully handled. */
 396 static int
 397 emacs_gnutls_handle_error (gnutls_session_t session, int err)
 398 {
 399   int max_log_level = 0;
 400
 401   int ret;
 402   const char *str;
 403
 404   /* TODO: use a Lisp_Object generated by gnutls_make_error?  */
 405   if (err >= 0)
 406     return 0;
 407
 408   max_log_level = global_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 :min-prime-bits is the minimum accepted number of bits the client will
 650 accept in Diffie-Hellman key exchange.
 651
 652 The debug level will be set for this process AND globally for GnuTLS.
 653 So if you set it higher or lower at any point, it affects global
 654 debugging.
 655
 656 Note that the priority is set on the client.  The server does not use
 657 the protocols's priority except for disabling protocols that were not
 658 specified.
 659
 660 Processes must be initialized with this function before other GnuTLS
 661 functions are used.  This function allocates resources which can only
 662 be deallocated by calling `gnutls-deinit' or by calling it again.
 663
 664 The callbacks alist can have a `verify' key, associated with a
 665 verification function (UNUSED).
 666
 667 Each authentication type may need additional information in order to
 668 work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
 669 one trustfile (usually a CA bundle).  */)
 670   (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
 671 {
 672   int ret = GNUTLS_E_SUCCESS;
 673
 674   int max_log_level = 0;
 675
 676   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
 677   int file_format = GNUTLS_X509_FMT_PEM;
 678
 679   unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
 680   gnutls_x509_crt_t gnutls_verify_cert;
 681   unsigned int gnutls_verify_cert_list_size;
 682   const gnutls_datum_t *gnutls_verify_cert_list;
 683
 684   gnutls_session_t state;
 685   gnutls_certificate_credentials_t x509_cred;
 686   gnutls_anon_client_credentials_t anon_cred;
 687   Lisp_Object global_init;
 688   char const *priority_string_ptr = "NORMAL"; /* default priority string.  */
 689   Lisp_Object tail;
 690   unsigned int peer_verification;
 691   char* c_hostname;
 692
 693   /* Placeholders for the property list elements.  */
 694   Lisp_Object priority_string;
 695   Lisp_Object trustfiles;
 696   Lisp_Object crlfiles;
 697   Lisp_Object keylist;
 698   /* Lisp_Object callbacks; */
 699   Lisp_Object loglevel;
 700   Lisp_Object hostname;
 701   Lisp_Object verify_flags;
 702   /* Lisp_Object verify_error; */
 703   Lisp_Object verify_hostname_error;
 704   Lisp_Object prime_bits;
 705
 706   CHECK_PROCESS (proc);
 707   CHECK_SYMBOL (type);
 708   CHECK_LIST (proplist);
 709
 710   if (NILP (Fgnutls_available_p ()))
 711     {
 712       error ("GnuTLS not available");
 713       return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
 714     }
 715
 716   hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
 717   priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
 718   trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
 719   keylist               = Fplist_get (proplist, Qgnutls_bootprop_keylist);
 720   crlfiles              = Fplist_get (proplist, Qgnutls_bootprop_crlfiles);
 721   /* callbacks          = Fplist_get (proplist, Qgnutls_bootprop_callbacks); */
 722   loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
 723   verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
 724   /* verify_error       = Fplist_get (proplist, Qgnutls_bootprop_verify_error); */
 725   verify_hostname_error = Fplist_get (proplist, Qgnutls_bootprop_verify_hostname_error);
 726   prime_bits            = Fplist_get (proplist, Qgnutls_bootprop_min_prime_bits);
 727
 728   if (!STRINGP (hostname))
 729     error ("gnutls-boot: invalid :hostname parameter");
 730
 731   c_hostname = SSDATA (hostname);
 732
 733   state = XPROCESS (proc)->gnutls_state;
 734   XPROCESS (proc)->gnutls_p = 1;
 735
 736   if (NUMBERP (loglevel))
 737     {
 738       fn_gnutls_global_set_log_function (gnutls_log_function);
 739       fn_gnutls_global_set_log_level (XINT (loglevel));
 740       max_log_level = XINT (loglevel);
 741       XPROCESS (proc)->gnutls_log_level = max_log_level;
 742     }
 743
 744   /* always initialize globals.  */
 745   global_init = emacs_gnutls_global_init ();
 746   if (! NILP (Fgnutls_errorp (global_init)))
 747     return global_init;
 748
 749   /* deinit and free resources.  */
 750   if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_CRED_ALLOC)
 751     {
 752       GNUTLS_LOG (1, max_log_level, "deallocating credentials");
 753
 754       if (EQ (type, Qgnutls_x509pki))
 755         {
 756           GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
 757           x509_cred = XPROCESS (proc)->gnutls_x509_cred;
 758           fn_gnutls_certificate_free_credentials (x509_cred);
 759         }
 760       else if (EQ (type, Qgnutls_anon))
 761         {
 762           GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
 763           anon_cred = XPROCESS (proc)->gnutls_anon_cred;
 764           fn_gnutls_anon_free_client_credentials (anon_cred);
 765         }
 766       else
 767         {
 768           error ("unknown credential type");
 769           ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
 770         }
 771
 772       if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
 773         {
 774           GNUTLS_LOG (1, max_log_level, "deallocating x509 credentials");
 775           Fgnutls_deinit (proc);
 776         }
 777     }
 778
 779   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
 780
 781   GNUTLS_LOG (1, max_log_level, "allocating credentials");
 782
 783   if (EQ (type, Qgnutls_x509pki))
 784     {
 785       GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
 786       x509_cred = XPROCESS (proc)->gnutls_x509_cred;
 787       fn_gnutls_certificate_allocate_credentials (&x509_cred);
 788
 789       if (NUMBERP (verify_flags))
 790         {
 791           gnutls_verify_flags = XINT (verify_flags);
 792           GNUTLS_LOG (2, max_log_level, "setting verification flags");
 793         }
 794       else if (NILP (verify_flags))
 795         {
 796           /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
 797           GNUTLS_LOG (2, max_log_level, "using default verification flags");
 798         }
 799       else
 800         {
 801           /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT.  */
 802           GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
 803         }
 804       fn_gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
 805     }
 806   else if (EQ (type, Qgnutls_anon))
 807     {
 808       GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
 809       anon_cred = XPROCESS (proc)->gnutls_anon_cred;
 810       fn_gnutls_anon_allocate_client_credentials (&anon_cred);
 811     }
 812   else
 813     {
 814       error ("unknown credential type");
 815       ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
 816     }
 817
 818   if (ret < GNUTLS_E_SUCCESS)
 819     return gnutls_make_error (ret);
 820
 821   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
 822
 823   if (EQ (type, Qgnutls_x509pki))
 824     {
 825       for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
 826         {
 827           Lisp_Object trustfile = Fcar (tail);
 828           if (STRINGP (trustfile))
 829             {
 830               GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
 831                            SSDATA (trustfile));
 832               ret = fn_gnutls_certificate_set_x509_trust_file
 833                 (x509_cred,
 834                  SSDATA (trustfile),
 835                  file_format);
 836
 837               if (ret < GNUTLS_E_SUCCESS)
 838                 return gnutls_make_error (ret);
 839             }
 840           else
 841             {
 842               error ("Sorry, GnuTLS can't use non-string trustfile %s",
 843                      SDATA (trustfile));
 844             }
 845         }
 846
 847       for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
 848         {
 849           Lisp_Object crlfile = Fcar (tail);
 850           if (STRINGP (crlfile))
 851             {
 852               GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
 853                            SSDATA (crlfile));
 854               ret = fn_gnutls_certificate_set_x509_crl_file
 855                 (x509_cred,
 856                  SSDATA (crlfile),
 857                  file_format);
 858
 859               if (ret < GNUTLS_E_SUCCESS)
 860                 return gnutls_make_error (ret);
 861             }
 862           else
 863             {
 864               error ("Sorry, GnuTLS can't use non-string CRL file %s",
 865                      SDATA (crlfile));
 866             }
 867         }
 868
 869       for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
 870         {
 871           Lisp_Object keyfile = Fcar (Fcar (tail));
 872           Lisp_Object certfile = Fcar (Fcdr (tail));
 873           if (STRINGP (keyfile) && STRINGP (certfile))
 874             {
 875               GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
 876                            SSDATA (keyfile));
 877               GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
 878                            SSDATA (certfile));
 879               ret = fn_gnutls_certificate_set_x509_key_file
 880                 (x509_cred,
 881                  SSDATA (certfile),
 882                  SSDATA (keyfile),
 883                  file_format);
 884
 885               if (ret < GNUTLS_E_SUCCESS)
 886                 return gnutls_make_error (ret);
 887             }
 888           else
 889             {
 890               if (STRINGP (keyfile))
 891                 error ("Sorry, GnuTLS can't use non-string client cert file %s",
 892                        SDATA (certfile));
 893               else
 894                 error ("Sorry, GnuTLS can't use non-string client key file %s",
 895                        SDATA (keyfile));
 896             }
 897         }
 898     }
 899
 900   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 901
 902   GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
 903
 904   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
 905
 906 #ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
 907 #else
 908 #endif
 909
 910   GNUTLS_LOG (1, max_log_level, "gnutls_init");
 911
 912   ret = fn_gnutls_init (&state, GNUTLS_CLIENT);
 913
 914   if (ret < GNUTLS_E_SUCCESS)
 915     return gnutls_make_error (ret);
 916
 917   XPROCESS (proc)->gnutls_state = state;
 918
 919   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
 920
 921   if (STRINGP (priority_string))
 922     {
 923       priority_string_ptr = SSDATA (priority_string);
 924       GNUTLS_LOG2 (1, max_log_level, "got non-default priority string:",
 925                    priority_string_ptr);
 926     }
 927   else
 928     {
 929       GNUTLS_LOG2 (1, max_log_level, "using default priority string:",
 930                    priority_string_ptr);
 931     }
 932
 933   GNUTLS_LOG (1, max_log_level, "setting the priority string");
 934
 935   ret = fn_gnutls_priority_set_direct (state,
 936                                        priority_string_ptr,
 937                                        NULL);
 938
 939   if (ret < GNUTLS_E_SUCCESS)
 940     return gnutls_make_error (ret);
 941
 942   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
 943
 944   if (!EQ (prime_bits, Qnil))
 945     {
 946       fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
 947     }
 948
 949   if (EQ (type, Qgnutls_x509pki))
 950     {
 951       ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
 952     }
 953   else if (EQ (type, Qgnutls_anon))
 954     {
 955       ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_ANON, anon_cred);
 956     }
 957   else
 958     {
 959       error ("unknown credential type");
 960       ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
 961     }
 962
 963   if (ret < GNUTLS_E_SUCCESS)
 964     return gnutls_make_error (ret);
 965
 966   XPROCESS (proc)->gnutls_anon_cred = anon_cred;
 967   XPROCESS (proc)->gnutls_x509_cred = x509_cred;
 968   XPROCESS (proc)->gnutls_cred_type = type;
 969
 970   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 971
 972   ret = emacs_gnutls_handshake (XPROCESS (proc));
 973
 974   if (ret < GNUTLS_E_SUCCESS)
 975     return gnutls_make_error (ret);
 976
 977   /* Now verify the peer, following
 978      http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
 979      The peer should present at least one certificate in the chain; do a
 980      check of the certificate's hostname with
 981      gnutls_x509_crt_check_hostname() against :hostname.  */
 982
 983   ret = fn_gnutls_certificate_verify_peers2 (state, &peer_verification);
 984
 985   if (ret < GNUTLS_E_SUCCESS)
 986     return gnutls_make_error (ret);
 987
 988   if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
 989     message ("%s certificate could not be verified.",
 990              c_hostname);
 991
 992  if (peer_verification & GNUTLS_CERT_REVOKED)
 993    GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
 994                 c_hostname);
 995
 996  if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
 997    GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
 998                 c_hostname);
 999
1000  if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
1001    GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
1002                 c_hostname);
1003
1004  if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
1005    GNUTLS_LOG2 (1, max_log_level,
1006                 "certificate was signed with an insecure algorithm:",
1007                 c_hostname);
1008
1009  if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
1010    GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
1011                 c_hostname);
1012
1013  if (peer_verification & GNUTLS_CERT_EXPIRED)
1014    GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
1015                 c_hostname);
1016
1017  if (peer_verification != 0)
1018    {
1019      if (NILP (verify_hostname_error))
1020        {
1021          GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
1022                       c_hostname);
1023        }
1024      else
1025        {
1026          error ("Certificate validation failed %s, verification code %d",
1027                 c_hostname, peer_verification);
1028        }
1029    }
1030
1031   /* Up to here the process is the same for X.509 certificates and
1032      OpenPGP keys.  From now on X.509 certificates are assumed.  This
1033      can be easily extended to work with openpgp keys as well.  */
1034   if (fn_gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
1035     {
1036       ret = fn_gnutls_x509_crt_init (&gnutls_verify_cert);
1037
1038       if (ret < GNUTLS_E_SUCCESS)
1039         return gnutls_make_error (ret);
1040
1041       gnutls_verify_cert_list =
1042         fn_gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
1043
1044       if (NULL == gnutls_verify_cert_list)
1045         {
1046           error ("No x509 certificate was found!\n");
1047         }
1048
1049       /* We only check the first certificate in the given chain.  */
1050       ret = fn_gnutls_x509_crt_import (gnutls_verify_cert,
1051                                        &gnutls_verify_cert_list[0],
1052                                        GNUTLS_X509_FMT_DER);
1053
1054       if (ret < GNUTLS_E_SUCCESS)
1055         {
1056           fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1057           return gnutls_make_error (ret);
1058         }
1059
1060       if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
1061         {
1062           if (NILP (verify_hostname_error))
1063             {
1064               GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
1065                            c_hostname);
1066             }
1067           else
1068             {
1069               fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1070               error ("The x509 certificate does not match \"%s\"",
1071                      c_hostname);
1072             }
1073         }
1074
1075       fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
1076     }
1077
1078   return gnutls_make_error (ret);
1079 }
1080
1081 DEFUN ("gnutls-bye", Fgnutls_bye,
1082        Sgnutls_bye, 2, 2, 0,
1083        doc: /* Terminate current GnuTLS connection for process PROC.
1084 The connection should have been initiated using `gnutls-handshake'.
1085
1086 If CONT is not nil the TLS connection gets terminated and further
1087 receives and sends will be disallowed.  If the return value is zero you
1088 may continue using the connection.  If CONT is nil, GnuTLS actually
1089 sends an alert containing a close request and waits for the peer to
1090 reply with the same message.  In order to reuse the connection you
1091 should wait for an EOF from the peer.
1092
1093 This function may also return `gnutls-e-again', or
1094 `gnutls-e-interrupted'.  */)
1095     (Lisp_Object proc, Lisp_Object cont)
1096 {
1097   gnutls_session_t state;
1098   int ret;
1099
1100   CHECK_PROCESS (proc);
1101
1102   state = XPROCESS (proc)->gnutls_state;
1103
1104   ret = fn_gnutls_bye (state,
1105                        NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR);
1106
1107   return gnutls_make_error (ret);
1108 }
1109
1110 void
1111 syms_of_gnutls (void)
1112 {
1113   gnutls_global_initialized = 0;
1114
1115   DEFSYM (Qgnutls_dll, "gnutls");
1116   DEFSYM (Qgnutls_code, "gnutls-code");
1117   DEFSYM (Qgnutls_anon, "gnutls-anon");
1118   DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
1119   DEFSYM (Qgnutls_bootprop_hostname, ":hostname");
1120   DEFSYM (Qgnutls_bootprop_priority, ":priority");
1121   DEFSYM (Qgnutls_bootprop_trustfiles, ":trustfiles");
1122   DEFSYM (Qgnutls_bootprop_keylist, ":keylist");
1123   DEFSYM (Qgnutls_bootprop_crlfiles, ":crlfiles");
1124   DEFSYM (Qgnutls_bootprop_callbacks, ":callbacks");
1125   DEFSYM (Qgnutls_bootprop_callbacks_verify, "verify");
1126   DEFSYM (Qgnutls_bootprop_min_prime_bits, ":min-prime-bits");
1127   DEFSYM (Qgnutls_bootprop_loglevel, ":loglevel");
1128   DEFSYM (Qgnutls_bootprop_verify_flags, ":verify-flags");
1129   DEFSYM (Qgnutls_bootprop_verify_hostname_error, ":verify-hostname-error");
1130
1131   DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
1132   Fput (Qgnutls_e_interrupted, Qgnutls_code,
1133         make_number (GNUTLS_E_INTERRUPTED));
1134
1135   DEFSYM (Qgnutls_e_again, "gnutls-e-again");
1136   Fput (Qgnutls_e_again, Qgnutls_code,
1137         make_number (GNUTLS_E_AGAIN));
1138
1139   DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session");
1140   Fput (Qgnutls_e_invalid_session, Qgnutls_code,
1141         make_number (GNUTLS_E_INVALID_SESSION));
1142
1143   DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake");
1144   Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code,
1145         make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
1146
1147   defsubr (&Sgnutls_get_initstage);
1148   defsubr (&Sgnutls_errorp);
1149   defsubr (&Sgnutls_error_fatalp);
1150   defsubr (&Sgnutls_error_string);
1151   defsubr (&Sgnutls_boot);
1152   defsubr (&Sgnutls_deinit);
1153   defsubr (&Sgnutls_bye);
1154   defsubr (&Sgnutls_available_p);
1155
1156   DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
1157               doc: /* Logging level used by the GnuTLS functions.  */);
1158   global_gnutls_log_level = 0;
1159 }
1160
1161 #endif /* HAVE_GNUTLS */