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