src/gnutls.c

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