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