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