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