src/gnutls.c

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