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