gnutls.c 94.3 KB
Newer Older
Ted Zlatanov's avatar
Ted Zlatanov committed
1
/* GnuTLS glue for GNU Emacs.
2
   Copyright (C) 2010-2019 Free Software Foundation, Inc.
Ted Zlatanov's avatar
Ted Zlatanov committed
3 4 5 6 7

This file is part of GNU Emacs.

GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
8 9
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Ted Zlatanov's avatar
Ted Zlatanov committed
10 11 12 13 14 15 16

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
17
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
Ted Zlatanov's avatar
Ted Zlatanov committed
18 19 20

#include <config.h>
#include <errno.h>
21
#include <stdio.h>
Ted Zlatanov's avatar
Ted Zlatanov committed
22 23 24

#include "lisp.h"
#include "process.h"
25
#include "gnutls.h"
26
#include "coding.h"
27
#include "buffer.h"
Daniel Colascione's avatar
Daniel Colascione committed
28
#include "pdumper.h"
Ted Zlatanov's avatar
Ted Zlatanov committed
29

30
#if GNUTLS_VERSION_NUMBER >= 0x030014
31 32
# define HAVE_GNUTLS_X509_SYSTEM_TRUST
#endif
Ted Zlatanov's avatar
Ted Zlatanov committed
33

34 35
#if GNUTLS_VERSION_NUMBER >= 0x030200
# define HAVE_GNUTLS_CIPHER_GET_IV_SIZE
36 37
#endif

38 39 40
#if GNUTLS_VERSION_NUMBER >= 0x030202
# define HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
# define HAVE_GNUTLS_DIGEST_LIST /* also gnutls_digest_get_name */
41 42
#endif

43 44
#if GNUTLS_VERSION_NUMBER >= 0x030205
# define HAVE_GNUTLS_EXT__DUMBFW
45 46
#endif

47 48 49 50
#if GNUTLS_VERSION_NUMBER >= 0x030400
# define HAVE_GNUTLS_ETM_STATUS
#endif

51 52 53 54 55 56
/* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was
   exported only since 3.3.0. */
#if GNUTLS_VERSION_NUMBER >= 0x030300
# define HAVE_GNUTLS_MAC_GET_NONCE_SIZE
#endif

57 58 59 60
#if GNUTLS_VERSION_NUMBER >= 0x030501
# define HAVE_GNUTLS_EXT_GET_NAME
#endif

61 62 63 64 65 66 67 68
/* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14,
   it was broken through at least GnuTLS 3.4.10; see:
   https://lists.gnu.org/r/emacs-devel/2017-07/msg00992.html
   The relevant fix seems to have been made in GnuTLS 3.5.1; see:
   https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d
   So, require 3.5.1.  */
#if GNUTLS_VERSION_NUMBER >= 0x030501
# define HAVE_GNUTLS_AEAD
69 70
#endif

71 72 73 74
#ifdef HAVE_GNUTLS

# ifdef WINDOWSNT
#  include <windows.h>
75
#  include "w32common.h"
76 77 78
#  include "w32.h"
# endif

79
static int emacs_gnutls_handle_error (gnutls_session_t, int);
80

81
static bool gnutls_global_initialized;
Ted Zlatanov's avatar
Ted Zlatanov committed
82

83
static void gnutls_log_function (int, const char *);
84
static void gnutls_log_function2 (int, const char *, const char *);
85
# ifdef HAVE_GNUTLS3
86
static void gnutls_audit_log_function (gnutls_session_t, const char *);
87
# endif
88

89 90 91 92
enum extra_peer_verification
{
    CERTIFICATE_NOT_MATCHING = 2
};
93

94

95
# ifdef WINDOWSNT
96

97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
DEF_DLL_FN (gnutls_alert_description_t, gnutls_alert_get,
	    (gnutls_session_t));
DEF_DLL_FN (const char *, gnutls_alert_get_name,
	    (gnutls_alert_description_t));
DEF_DLL_FN (int, gnutls_anon_allocate_client_credentials,
	    (gnutls_anon_client_credentials_t *));
DEF_DLL_FN (void, gnutls_anon_free_client_credentials,
	    (gnutls_anon_client_credentials_t));
DEF_DLL_FN (int, gnutls_bye, (gnutls_session_t, gnutls_close_request_t));
DEF_DLL_FN (int, gnutls_certificate_allocate_credentials,
	    (gnutls_certificate_credentials_t *));
DEF_DLL_FN (void, gnutls_certificate_free_credentials,
	    (gnutls_certificate_credentials_t));
DEF_DLL_FN (const gnutls_datum_t *, gnutls_certificate_get_peers,
	    (gnutls_session_t, unsigned int *));
DEF_DLL_FN (void, gnutls_certificate_set_verify_flags,
	    (gnutls_certificate_credentials_t, unsigned int));
DEF_DLL_FN (int, gnutls_certificate_set_x509_crl_file,
	    (gnutls_certificate_credentials_t, const char *,
	     gnutls_x509_crt_fmt_t));
DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file,
	    (gnutls_certificate_credentials_t, const char *, const char *,
	     gnutls_x509_crt_fmt_t));
120
#  ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
121 122
DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust,
	    (gnutls_certificate_credentials_t));
123
#  endif
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
DEF_DLL_FN (int, gnutls_certificate_set_x509_trust_file,
	    (gnutls_certificate_credentials_t, const char *,
	     gnutls_x509_crt_fmt_t));
DEF_DLL_FN (gnutls_certificate_type_t, gnutls_certificate_type_get,
	    (gnutls_session_t));
DEF_DLL_FN (int, gnutls_certificate_verify_peers2,
	    (gnutls_session_t, unsigned int *));
DEF_DLL_FN (int, gnutls_credentials_set,
	    (gnutls_session_t, gnutls_credentials_type_t, void *));
DEF_DLL_FN (void, gnutls_deinit, (gnutls_session_t));
DEF_DLL_FN (void, gnutls_dh_set_prime_bits,
	    (gnutls_session_t, unsigned int));
DEF_DLL_FN (int, gnutls_dh_get_prime_bits, (gnutls_session_t));
DEF_DLL_FN (int, gnutls_error_is_fatal, (int));
DEF_DLL_FN (int, gnutls_global_init, (void));
DEF_DLL_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
140
#  ifdef HAVE_GNUTLS3
141
DEF_DLL_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func));
142
#  endif
143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
DEF_DLL_FN (void, gnutls_global_set_log_level, (int));
DEF_DLL_FN (int, gnutls_handshake, (gnutls_session_t));
DEF_DLL_FN (int, gnutls_init, (gnutls_session_t *, unsigned int));
DEF_DLL_FN (int, gnutls_priority_set_direct,
	    (gnutls_session_t, const char *, const char **));
DEF_DLL_FN (size_t, gnutls_record_check_pending, (gnutls_session_t));
DEF_DLL_FN (ssize_t, gnutls_record_recv, (gnutls_session_t, void *, size_t));
DEF_DLL_FN (ssize_t, gnutls_record_send,
	    (gnutls_session_t, const void *, size_t));
DEF_DLL_FN (const char *, gnutls_strerror, (int));
DEF_DLL_FN (void, gnutls_transport_set_errno, (gnutls_session_t, int));
DEF_DLL_FN (void, gnutls_transport_set_ptr2,
	    (gnutls_session_t, gnutls_transport_ptr_t,
	     gnutls_transport_ptr_t));
DEF_DLL_FN (void, gnutls_transport_set_pull_function,
	    (gnutls_session_t, gnutls_pull_func));
DEF_DLL_FN (void, gnutls_transport_set_push_function,
	    (gnutls_session_t, gnutls_push_func));
DEF_DLL_FN (int, gnutls_x509_crt_check_hostname,
	    (gnutls_x509_crt_t, const char *));
163 164
DEF_DLL_FN (int, gnutls_x509_crt_check_issuer,
              (gnutls_x509_crt_t, gnutls_x509_crt_t));
165
DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
166
DEF_DLL_FN (int, gnutls_x509_crt_export,
167
            (gnutls_x509_crt_t, gnutls_x509_crt_fmt_t, void *, size_t *));
168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188
DEF_DLL_FN (int, gnutls_x509_crt_import,
	    (gnutls_x509_crt_t, const gnutls_datum_t *,
	     gnutls_x509_crt_fmt_t));
DEF_DLL_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_fingerprint,
	    (gnutls_x509_crt_t,
	     gnutls_digest_algorithm_t, void *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_version,
	    (gnutls_x509_crt_t));
DEF_DLL_FN (int, gnutls_x509_crt_get_serial,
	    (gnutls_x509_crt_t, void *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_issuer_dn,
	    (gnutls_x509_crt_t, char *, size_t *));
DEF_DLL_FN (time_t, gnutls_x509_crt_get_activation_time,
	    (gnutls_x509_crt_t));
DEF_DLL_FN (time_t, gnutls_x509_crt_get_expiration_time,
	    (gnutls_x509_crt_t));
DEF_DLL_FN (int, gnutls_x509_crt_get_dn,
	    (gnutls_x509_crt_t, char *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_pk_algorithm,
	    (gnutls_x509_crt_t, unsigned int *));
189 190 191
DEF_DLL_FN (int, gnutls_x509_crt_print,
            (gnutls_x509_crt_t, gnutls_certificate_print_formats_t,
             gnutls_datum_t *));
192
DEF_DLL_FN (const char *, gnutls_pk_algorithm_get_name,
193 194 195 196 197 198 199 200 201 202 203
	    (gnutls_pk_algorithm_t));
DEF_DLL_FN (int, gnutls_pk_bits_to_sec_param,
	    (gnutls_pk_algorithm_t, unsigned int));
DEF_DLL_FN (int, gnutls_x509_crt_get_issuer_unique_id,
	    (gnutls_x509_crt_t, char *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_subject_unique_id,
	    (gnutls_x509_crt_t, char *, size_t *));
DEF_DLL_FN (int, gnutls_x509_crt_get_signature_algorithm,
	    (gnutls_x509_crt_t));
DEF_DLL_FN (int, gnutls_x509_crt_get_key_id,
	    (gnutls_x509_crt_t, unsigned int, unsigned char *, size_t *_size));
204 205
DEF_DLL_FN (const char *, gnutls_sec_param_get_name, (gnutls_sec_param_t));
DEF_DLL_FN (const char *, gnutls_sign_get_name, (gnutls_sign_algorithm_t));
206 207 208 209
DEF_DLL_FN (int, gnutls_server_name_set,
	    (gnutls_session_t, gnutls_server_name_type_t,
	     const void *, size_t));
DEF_DLL_FN (gnutls_kx_algorithm_t, gnutls_kx_get, (gnutls_session_t));
210
DEF_DLL_FN (const char *, gnutls_kx_get_name, (gnutls_kx_algorithm_t));
211 212
DEF_DLL_FN (gnutls_protocol_t, gnutls_protocol_get_version,
	    (gnutls_session_t));
213
DEF_DLL_FN (const char *, gnutls_protocol_get_name, (gnutls_protocol_t));
214 215
DEF_DLL_FN (gnutls_cipher_algorithm_t, gnutls_cipher_get,
	    (gnutls_session_t));
216
DEF_DLL_FN (const char *, gnutls_cipher_get_name,
217 218
	    (gnutls_cipher_algorithm_t));
DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
219
DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
220 221 222 223 224
DEF_DLL_FN (gnutls_compression_method_t, gnutls_compression_get,
            (gnutls_session_t));
DEF_DLL_FN (const char *, gnutls_compression_get_name,
            (gnutls_compression_method_t));
DEF_DLL_FN (unsigned, gnutls_safe_renegotiation_status, (gnutls_session_t));
225

226
#  ifdef HAVE_GNUTLS3
227
DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
228
DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
229
#   ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
230
DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
231
#   endif
232
DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t));
233
#   ifdef HAVE_GNUTLS_DIGEST_LIST
234 235
DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void));
DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t));
236
#   endif
237
DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void));
238
#   ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
239
DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t));
240
#   endif
241 242
DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t));
DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t));
243
#   ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
244
DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t));
245
#   endif
246 247 248
DEF_DLL_FN (int, gnutls_cipher_init,
	    (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t,
	     const gnutls_datum_t *, const gnutls_datum_t *));
249 250 251 252 253 254
DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t));
DEF_DLL_FN (int, gnutls_cipher_encrypt2,
	    (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t));
DEF_DLL_FN (int, gnutls_cipher_decrypt2,
	    (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
255
#   ifdef HAVE_GNUTLS_AEAD
256 257 258 259 260 261 262 263 264 265
DEF_DLL_FN (int, gnutls_aead_cipher_init,
	    (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t,
	     const gnutls_datum_t *));
DEF_DLL_FN (void, gnutls_aead_cipher_deinit, (gnutls_aead_cipher_hd_t));
DEF_DLL_FN (int, gnutls_aead_cipher_encrypt,
	    (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
	     size_t, size_t, const void *, size_t, void *, size_t *));
DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
	    (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
	     size_t, size_t, const void *, size_t, void *, size_t *));
266
#   endif
267 268 269
#   ifdef HAVE_GNUTLS_ETM_STATUS
DEF_DLL_FN (unsigned, gnutls_session_etm_status, (gnutls_session_t));
#   endif
270 271 272 273 274 275
DEF_DLL_FN (int, gnutls_hmac_init,
	    (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t));
DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *));
DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *));
276 277
  DEF_DLL_FN (int, gnutls_hash_init,
	    (gnutls_hash_hd_t *, gnutls_digest_algorithm_t));
278 279 280 281
DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t));
DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t));
DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *));
DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *));
282 283 284
#   ifdef HAVE_GNUTLS_EXT_GET_NAME
DEF_DLL_FN (const char *, gnutls_ext_get_name, (unsigned int));
#   endif
285
#  endif	 /* HAVE_GNUTLS3 */
286

287

288
static bool
289
init_gnutls_functions (void)
290 291
{
  HMODULE library;
292
  int max_log_level = 1;
293

294
  if (!(library = w32_delayed_load (Qgnutls)))
295
    {
296
      GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
297 298 299
      return 0;
    }

300 301 302 303 304 305 306 307 308 309 310
  LOAD_DLL_FN (library, gnutls_alert_get);
  LOAD_DLL_FN (library, gnutls_alert_get_name);
  LOAD_DLL_FN (library, gnutls_anon_allocate_client_credentials);
  LOAD_DLL_FN (library, gnutls_anon_free_client_credentials);
  LOAD_DLL_FN (library, gnutls_bye);
  LOAD_DLL_FN (library, gnutls_certificate_allocate_credentials);
  LOAD_DLL_FN (library, gnutls_certificate_free_credentials);
  LOAD_DLL_FN (library, gnutls_certificate_get_peers);
  LOAD_DLL_FN (library, gnutls_certificate_set_verify_flags);
  LOAD_DLL_FN (library, gnutls_certificate_set_x509_crl_file);
  LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file);
311
#  ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
312
  LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust);
313
#  endif
314 315 316 317 318 319 320 321 322 323
  LOAD_DLL_FN (library, gnutls_certificate_set_x509_trust_file);
  LOAD_DLL_FN (library, gnutls_certificate_type_get);
  LOAD_DLL_FN (library, gnutls_certificate_verify_peers2);
  LOAD_DLL_FN (library, gnutls_credentials_set);
  LOAD_DLL_FN (library, gnutls_deinit);
  LOAD_DLL_FN (library, gnutls_dh_set_prime_bits);
  LOAD_DLL_FN (library, gnutls_dh_get_prime_bits);
  LOAD_DLL_FN (library, gnutls_error_is_fatal);
  LOAD_DLL_FN (library, gnutls_global_init);
  LOAD_DLL_FN (library, gnutls_global_set_log_function);
324
#  ifdef HAVE_GNUTLS3
325
  LOAD_DLL_FN (library, gnutls_global_set_audit_log_function);
326
#  endif
327 328 329 330 331 332 333 334 335 336 337 338 339
  LOAD_DLL_FN (library, gnutls_global_set_log_level);
  LOAD_DLL_FN (library, gnutls_handshake);
  LOAD_DLL_FN (library, gnutls_init);
  LOAD_DLL_FN (library, gnutls_priority_set_direct);
  LOAD_DLL_FN (library, gnutls_record_check_pending);
  LOAD_DLL_FN (library, gnutls_record_recv);
  LOAD_DLL_FN (library, gnutls_record_send);
  LOAD_DLL_FN (library, gnutls_strerror);
  LOAD_DLL_FN (library, gnutls_transport_set_errno);
  LOAD_DLL_FN (library, gnutls_transport_set_ptr2);
  LOAD_DLL_FN (library, gnutls_transport_set_pull_function);
  LOAD_DLL_FN (library, gnutls_transport_set_push_function);
  LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname);
340
  LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer);
341
  LOAD_DLL_FN (library, gnutls_x509_crt_deinit);
342
  LOAD_DLL_FN (library, gnutls_x509_crt_export);
343 344 345 346 347 348 349 350 351 352
  LOAD_DLL_FN (library, gnutls_x509_crt_import);
  LOAD_DLL_FN (library, gnutls_x509_crt_init);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_fingerprint);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_version);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_serial);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_dn);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_activation_time);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_expiration_time);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_dn);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_pk_algorithm);
353
  LOAD_DLL_FN (library, gnutls_x509_crt_print);
354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370
  LOAD_DLL_FN (library, gnutls_pk_algorithm_get_name);
  LOAD_DLL_FN (library, gnutls_pk_bits_to_sec_param);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_issuer_unique_id);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_subject_unique_id);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_signature_algorithm);
  LOAD_DLL_FN (library, gnutls_x509_crt_get_key_id);
  LOAD_DLL_FN (library, gnutls_sec_param_get_name);
  LOAD_DLL_FN (library, gnutls_sign_get_name);
  LOAD_DLL_FN (library, gnutls_server_name_set);
  LOAD_DLL_FN (library, gnutls_kx_get);
  LOAD_DLL_FN (library, gnutls_kx_get_name);
  LOAD_DLL_FN (library, gnutls_protocol_get_version);
  LOAD_DLL_FN (library, gnutls_protocol_get_name);
  LOAD_DLL_FN (library, gnutls_cipher_get);
  LOAD_DLL_FN (library, gnutls_cipher_get_name);
  LOAD_DLL_FN (library, gnutls_mac_get);
  LOAD_DLL_FN (library, gnutls_mac_get_name);
371 372 373
  LOAD_DLL_FN (library, gnutls_compression_get);
  LOAD_DLL_FN (library, gnutls_compression_get_name);
  LOAD_DLL_FN (library, gnutls_safe_renegotiation_status);
374
#  ifdef HAVE_GNUTLS3
375
  LOAD_DLL_FN (library, gnutls_rnd);
376
  LOAD_DLL_FN (library, gnutls_mac_list);
377
#   ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
378
  LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
379
#   endif
380
  LOAD_DLL_FN (library, gnutls_mac_get_key_size);
381
#   ifdef HAVE_GNUTLS_DIGEST_LIST
382 383
  LOAD_DLL_FN (library, gnutls_digest_list);
  LOAD_DLL_FN (library, gnutls_digest_get_name);
384
#   endif
385
  LOAD_DLL_FN (library, gnutls_cipher_list);
386
#   ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
387
  LOAD_DLL_FN (library, gnutls_cipher_get_iv_size);
388
#   endif
389 390
  LOAD_DLL_FN (library, gnutls_cipher_get_key_size);
  LOAD_DLL_FN (library, gnutls_cipher_get_block_size);
391
#   ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
392
  LOAD_DLL_FN (library, gnutls_cipher_get_tag_size);
393
#   endif
394 395 396 397
  LOAD_DLL_FN (library, gnutls_cipher_init);
  LOAD_DLL_FN (library, gnutls_cipher_set_iv);
  LOAD_DLL_FN (library, gnutls_cipher_encrypt2);
  LOAD_DLL_FN (library, gnutls_cipher_deinit);
398
  LOAD_DLL_FN (library, gnutls_cipher_decrypt2);
399
#   ifdef HAVE_GNUTLS_AEAD
400 401 402 403
  LOAD_DLL_FN (library, gnutls_aead_cipher_init);
  LOAD_DLL_FN (library, gnutls_aead_cipher_deinit);
  LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
  LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
404 405 406
#   endif
#   ifdef HAVE_GNUTLS_ETM_STATUS
  LOAD_DLL_FN (library, gnutls_session_etm_status);
407
#   endif
408 409 410 411 412 413 414 415 416 417
  LOAD_DLL_FN (library, gnutls_hmac_init);
  LOAD_DLL_FN (library, gnutls_hmac_get_len);
  LOAD_DLL_FN (library, gnutls_hmac);
  LOAD_DLL_FN (library, gnutls_hmac_deinit);
  LOAD_DLL_FN (library, gnutls_hmac_output);
  LOAD_DLL_FN (library, gnutls_hash_init);
  LOAD_DLL_FN (library, gnutls_hash_get_len);
  LOAD_DLL_FN (library, gnutls_hash);
  LOAD_DLL_FN (library, gnutls_hash_deinit);
  LOAD_DLL_FN (library, gnutls_hash_output);
418 419 420
#   ifdef HAVE_GNUTLS_EXT_GET_NAME
  LOAD_DLL_FN (library, gnutls_ext_get_name);
#   endif
421
#  endif	 /* HAVE_GNUTLS3 */
422

423
  max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
424
  {
425
    Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from));
426 427 428 429
    GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
                 STRINGP (name) ? (const char *) SDATA (name) : "unknown");
  }

430 431 432
  return 1;
}

433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464
#  define gnutls_alert_get fn_gnutls_alert_get
#  define gnutls_alert_get_name fn_gnutls_alert_get_name
#  define gnutls_anon_allocate_client_credentials fn_gnutls_anon_allocate_client_credentials
#  define gnutls_anon_free_client_credentials fn_gnutls_anon_free_client_credentials
#  define gnutls_bye fn_gnutls_bye
#  define gnutls_certificate_allocate_credentials fn_gnutls_certificate_allocate_credentials
#  define gnutls_certificate_free_credentials fn_gnutls_certificate_free_credentials
#  define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers
#  define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags
#  define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file
#  define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file
#  define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust
#  define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file
#  define gnutls_certificate_type_get fn_gnutls_certificate_type_get
#  define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2
#  define gnutls_cipher_get fn_gnutls_cipher_get
#  define gnutls_cipher_get_name fn_gnutls_cipher_get_name
#  define gnutls_credentials_set fn_gnutls_credentials_set
#  define gnutls_deinit fn_gnutls_deinit
#  define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits
#  define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits
#  define gnutls_error_is_fatal fn_gnutls_error_is_fatal
#  define gnutls_global_init fn_gnutls_global_init
#  define gnutls_global_set_audit_log_function fn_gnutls_global_set_audit_log_function
#  define gnutls_global_set_log_function fn_gnutls_global_set_log_function
#  define gnutls_global_set_log_level fn_gnutls_global_set_log_level
#  define gnutls_handshake fn_gnutls_handshake
#  define gnutls_init fn_gnutls_init
#  define gnutls_kx_get fn_gnutls_kx_get
#  define gnutls_kx_get_name fn_gnutls_kx_get_name
#  define gnutls_mac_get fn_gnutls_mac_get
#  define gnutls_mac_get_name fn_gnutls_mac_get_name
465 466
#  define gnutls_compression_get fn_gnutls_compression_get
#  define gnutls_compression_get_name fn_gnutls_compression_get_name
467
#  define gnutls_safe_renegotiation_status fn_gnutls_safe_renegotiation_status
468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486
#  define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
#  define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
#  define gnutls_priority_set_direct fn_gnutls_priority_set_direct
#  define gnutls_protocol_get_name fn_gnutls_protocol_get_name
#  define gnutls_protocol_get_version fn_gnutls_protocol_get_version
#  define gnutls_record_check_pending fn_gnutls_record_check_pending
#  define gnutls_record_recv fn_gnutls_record_recv
#  define gnutls_record_send fn_gnutls_record_send
#  define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name
#  define gnutls_server_name_set fn_gnutls_server_name_set
#  define gnutls_sign_get_name fn_gnutls_sign_get_name
#  define gnutls_strerror fn_gnutls_strerror
#  define gnutls_transport_set_errno fn_gnutls_transport_set_errno
#  define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2
#  define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function
#  define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function
#  define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
#  define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
#  define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
487
#  define gnutls_x509_crt_export fn_gnutls_x509_crt_export
488 489 490 491 492 493 494 495
#  define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
#  define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
#  define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time
#  define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint
#  define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn
#  define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id
#  define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
#  define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
496
#  define gnutls_x509_crt_print fn_gnutls_x509_crt_print
497 498 499 500 501 502 503 504 505
#  define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
#  define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
#  define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
#  define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
#  define gnutls_x509_crt_import fn_gnutls_x509_crt_import
#  define gnutls_x509_crt_init fn_gnutls_x509_crt_init
#  ifdef HAVE_GNUTLS3
#  define gnutls_rnd fn_gnutls_rnd
#  define gnutls_mac_list fn_gnutls_mac_list
506 507 508
#   ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
#    define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
#   endif
509
#  define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
510
#  ifdef HAVE_GNUTLS_DIGEST_LIST
511 512 513
#   define gnutls_digest_list fn_gnutls_digest_list
#   define gnutls_digest_get_name fn_gnutls_digest_get_name
#  endif
514
#  define gnutls_cipher_list fn_gnutls_cipher_list
515
#  ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
516 517
#   define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
#  endif
518 519
#  define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
#  define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
520
#  ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
521 522
#   define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
#  endif
523 524 525 526 527 528
#  define gnutls_cipher_init fn_gnutls_cipher_init
#  define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv
#  define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2
#  define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2
#  define gnutls_cipher_deinit fn_gnutls_cipher_deinit
#   ifdef HAVE_GNUTLS_AEAD
529 530 531 532
#    define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt
#    define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt
#    define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
#    define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
533
#   endif
534 535 536
#   ifdef HAVE_GNUTLS_ETM_STATUS
#    define gnutls_session_etm_status fn_gnutls_session_etm_status
#   endif
537 538 539 540 541 542 543 544 545 546
#  define gnutls_hmac_init fn_gnutls_hmac_init
#  define gnutls_hmac_get_len fn_gnutls_hmac_get_len
#  define gnutls_hmac fn_gnutls_hmac
#  define gnutls_hmac_deinit fn_gnutls_hmac_deinit
#  define gnutls_hmac_output fn_gnutls_hmac_output
#  define gnutls_hash_init fn_gnutls_hash_init
#  define gnutls_hash_get_len fn_gnutls_hash_get_len
#  define gnutls_hash fn_gnutls_hash
#  define gnutls_hash_deinit fn_gnutls_hash_deinit
#  define gnutls_hash_output fn_gnutls_hash_output
547 548 549
#   ifdef HAVE_GNUTLS_EXT_GET_NAME
#    define gnutls_ext_get_name fn_gnutls_ext_get_name
#   endif
550
#  endif	 /* HAVE_GNUTLS3 */
551

552

553 554 555 556 557 558 559
/* This wrapper is called from fns.c, which doesn't know about the
   LOAD_DLL_FN stuff above.  */
int
w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len)
{
  return gnutls_rnd (level, data, len);
}
560

561
# endif	/* WINDOWSNT */
562 563


564 565 566 567 568 569 570 571 572 573 574
/* Report memory exhaustion if ERR is an out-of-memory indication.  */
static void
check_memory_full (int err)
{
  /* When GnuTLS exhausts memory, it doesn't say how much memory it
     asked for, so tell the Emacs allocator that GnuTLS asked for no
     bytes.  This isn't accurate, but it's good enough.  */
  if (err == GNUTLS_E_MEMORY_ERROR)
    memory_full (0);
}

575
# ifdef HAVE_GNUTLS3
576
/* Log a simple audit message.  */
577
static void
578
gnutls_audit_log_function (gnutls_session_t session, const char *string)
579 580 581 582 583 584
{
  if (global_gnutls_log_level >= 1)
    {
      message ("gnutls.c: [audit] %s", string);
    }
}
585
# endif
586

587
/* Log a simple message.  */
588
static void
589
gnutls_log_function (int level, const char *string)
590 591 592 593
{
  message ("gnutls.c: [%d] %s", level, string);
}

594
/* Log a message and a string.  */
595
static void
596
gnutls_log_function2 (int level, const char *string, const char *extra)
597 598 599 600
{
  message ("gnutls.c: [%d] %s %s", level, string, extra);
}

601 602 603 604 605
int
gnutls_try_handshake (struct Lisp_Process *proc)
{
  gnutls_session_t state = proc->gnutls_state;
  int ret;
606
  bool non_blocking = proc->is_non_blocking_client;
607

608 609 610 611
  if (proc->gnutls_complete_negotiation_p)
    non_blocking = false;

  if (non_blocking)
612 613
    proc->gnutls_p = true;

614
  while ((ret = gnutls_handshake (state)) < 0)
615
    {
616 617 618 619 620 621 622
      do
	ret = gnutls_handshake (state);
      while (ret == GNUTLS_E_INTERRUPTED);

      if (0 <= ret || emacs_gnutls_handle_error (state, ret) == 0
	  || non_blocking)
	break;
623
      maybe_quit ();
624 625 626 627 628 629 630 631 632 633 634
    }

  proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;

  if (ret == GNUTLS_E_SUCCESS)
    {
      /* Here we're finally done.  */
      proc->gnutls_initstage = GNUTLS_STAGE_READY;
    }
  else
    {
635
      /* check_memory_full (gnutls_alert_send_appropriate (state, ret));  */
636 637 638 639
    }
  return ret;
}

640
# ifndef WINDOWSNT
641 642 643 644 645 646 647
static int
emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
{
  int err = errno;

  switch (err)
    {
648
#  ifdef _AIX
649
      /* This is taken from the GnuTLS system_errno function circa 2016;
650
	 see <https://savannah.gnu.org/support/?107464>.  */
651 652 653
    case 0:
      errno = EAGAIN;
      /* Fall through.  */
654
#  endif
655 656 657 658 659 660 661 662
    case EINPROGRESS:
    case ENOTCONN:
      return EAGAIN;

    default:
      return err;
    }
}
663
# endif	/* !WINDOWSNT */
664

665
static int
666 667 668 669 670
emacs_gnutls_handshake (struct Lisp_Process *proc)
{
  gnutls_session_t state = proc->gnutls_state;

  if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
671
    return -1;
672 673

  if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
674
    {
675
# ifdef WINDOWSNT
676
      /* On W32 we cannot transfer socket handles between different runtime
Andreas Schwab's avatar
Andreas Schwab committed
677 678
	 libraries, so we tell GnuTLS to use our special push/pull
	 functions.  */
679 680 681 682 683
      gnutls_transport_set_ptr2 (state,
				 (gnutls_transport_ptr_t) proc,
				 (gnutls_transport_ptr_t) proc);
      gnutls_transport_set_push_function (state, &emacs_gnutls_push);
      gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
684
# else
685
      /* This is how GnuTLS takes sockets: as file descriptors passed
Andreas Schwab's avatar
Andreas Schwab committed
686 687
	 in.  For an Emacs process socket, infd and outfd are the
	 same but we use this two-argument version for clarity.  */
688 689 690
      gnutls_transport_set_ptr2 (state,
				 (void *) (intptr_t) proc->infd,
				 (void *) (intptr_t) proc->outfd);
691 692 693
      if (proc->is_non_blocking_client)
	gnutls_transport_set_errno_function (state,
					     emacs_gnutls_nonblock_errno);
694
# endif
695

696 697
      proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
    }
698

699
  return gnutls_try_handshake (proc);
700 701
}

702
ptrdiff_t
703 704
emacs_gnutls_record_check_pending (gnutls_session_t state)
{
705
  return gnutls_record_check_pending (state);
706 707
}

708
# ifdef WINDOWSNT
709 710 711
void
emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
{
712
  gnutls_transport_set_errno (state, err);
713
}
714
# endif
715

716 717
ptrdiff_t
emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
Ted Zlatanov's avatar
Ted Zlatanov committed
718
{
719 720
  gnutls_session_t state = proc->gnutls_state;

721 722 723 724 725
  if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
    {
      errno = EAGAIN;
      return 0;
    }
Ted Zlatanov's avatar
Ted Zlatanov committed
726

727
  ptrdiff_t bytes_written = 0;
Ted Zlatanov's avatar
Ted Zlatanov committed
728 729 730

  while (nbyte > 0)
    {
731 732 733 734
      ssize_t rtnval;
      do
	rtnval = gnutls_record_send (state, buf, nbyte);
      while (rtnval == GNUTLS_E_INTERRUPTED);
Ted Zlatanov's avatar
Ted Zlatanov committed
735

736
      if (rtnval < 0)
Andreas Schwab's avatar
Andreas Schwab committed
737
	{
738 739
	  emacs_gnutls_handle_error (state, rtnval);
	  break;
Andreas Schwab's avatar
Andreas Schwab committed
740
	}
Ted Zlatanov's avatar
Ted Zlatanov committed
741 742 743 744 745 746 747 748 749

      buf += rtnval;
      nbyte -= rtnval;
      bytes_written += rtnval;
    }

  return (bytes_written);
}

750 751
ptrdiff_t
emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
Ted Zlatanov's avatar
Ted Zlatanov committed
752
{
753 754
  gnutls_session_t state = proc->gnutls_state;

755
  if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
756 757 758 759
    {
      errno = EAGAIN;
      return -1;
    }
760

761 762 763 764 765
  ssize_t rtnval;
  do
    rtnval = gnutls_record_recv (state, buf, nbyte);
  while (rtnval == GNUTLS_E_INTERRUPTED);

766 767
  if (rtnval >= 0)
    return rtnval;
768 769 770
  else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
    /* The peer closed the connection. */
    return 0;
771 772
  else
    return emacs_gnutls_handle_error (state, rtnval);
Ted Zlatanov's avatar
Ted Zlatanov committed
773 774
}

775 776 777 778 779 780 781
static char const *
emacs_gnutls_strerror (int err)
{
  char const *str = gnutls_strerror (err);
  return str ? str : "unknown";
}

782
/* Report a GnuTLS error to the user.
783 784 785 786
   SESSION is the GnuTLS session, ERR is the (negative) GnuTLS error code.
   Return 0 if the error was fatal, -1 (setting errno) otherwise so
   that the caller can notice the error and attempt a repair.  */
static int
787 788
emacs_gnutls_handle_error (gnutls_session_t session, int err)
{
789
  int ret;
790 791 792

  /* TODO: use a Lisp_Object generated by gnutls_make_error?  */

793 794
  check_memory_full (err);

795 796
  int max_log_level
    = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
797 798 799

  /* TODO: use gnutls-error-fatalp and gnutls-error-string.  */

800
  char const *str = emacs_gnutls_strerror (err);
801
  int errnum = EINVAL;
802

803
  if (gnutls_error_is_fatal (err))
804
    {
805 806 807 808
      int level = 1;
      /* Mostly ignore "The TLS connection was non-properly
	 terminated" message which just means that the peer closed the
	 connection.  */
809
# ifdef HAVE_GNUTLS3
810 811
      if (err == GNUTLS_E_PREMATURE_TERMINATION)
	level = 3;
812
# endif
813 814

      GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
815
      ret = 0;
816 817 818
    }
  else
    {
819
      ret = -1;
820 821 822 823 824 825 826 827

      switch (err)
        {
        case GNUTLS_E_AGAIN:
          GNUTLS_LOG2 (3,
                       max_log_level,
                       "retry:",
                       str);
828
	  FALLTHROUGH;
829 830 831 832 833 834
        default:
          GNUTLS_LOG2 (1,
                       max_log_level,
                       "non-fatal error:",
                       str);
        }
835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854

      switch (err)
	{
	case GNUTLS_E_AGAIN:
	  errnum = EAGAIN;
	  break;

# ifdef EMSGSIZE
	case GNUTLS_E_LARGE_PACKET:
	case GNUTLS_E_PUSH_ERROR:
	  errnum = EMSGSIZE;
	  break;
# endif

# if defined HAVE_GNUTLS3 && defined ECONNRESET
	case GNUTLS_E_PREMATURE_TERMINATION:
	  errnum = ECONNRESET;
	  break;
# endif
	}
855 856 857 858 859
    }

  if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
      || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
    {
860
      int alert = gnutls_alert_get (session);
861
      int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
862
      str = gnutls_alert_get_name (alert);
863 864 865 866 867
      if (!str)
	str = "unknown";

      GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str);
    }
868 869

  errno = errnum;
870 871 872
  return ret;
}

Ted Zlatanov's avatar
Ted Zlatanov committed
873 874 875 876
/* convert an integer error to a Lisp_Object; it will be either a
   known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or
   simply the integer value of the error.  GNUTLS_E_SUCCESS is mapped
   to Qt.  */
877
static Lisp_Object
878
gnutls_make_error (int err)
Ted Zlatanov's avatar
Ted Zlatanov committed
879
{
880
  switch (err)
881 882 883 884 885 886 887 888 889 890
    {
    case GNUTLS_E_SUCCESS:
      return Qt;
    case GNUTLS_E_AGAIN:
      return Qgnutls_e_again;
    case GNUTLS_E_INTERRUPTED:
      return Qgnutls_e_interrupted;
    case GNUTLS_E_INVALID_SESSION:
      return Qgnutls_e_invalid_session;
    }
Ted Zlatanov's avatar
Ted Zlatanov committed
891

892
  check_memory_full (err);
893
  return make_fixnum (err);
Ted Zlatanov's avatar
Ted Zlatanov committed
894 895
}

896 897 898 899 900 901 902 903 904 905 906 907 908
static void
gnutls_deinit_certificates (struct Lisp_Process *p)
{
  if (! p->gnutls_certificates)
    return;

  for (int i = 0; i < p->gnutls_certificates_length; i++)
    gnutls_x509_crt_deinit (p->gnutls_certificates[i]);

  xfree (p->gnutls_certificates);
  p->gnutls_certificates = NULL;
}

909 910 911 912 913 914 915
Lisp_Object
emacs_gnutls_deinit (Lisp_Object proc)
{
  int log_level;

  CHECK_PROCESS (proc);

916
  if (! XPROCESS (proc)->gnutls_p)
917 918 919 920 921 922 923
    return Qnil;

  log_level = XPROCESS (proc)->gnutls_log_level;

  if (XPROCESS (proc)->gnutls_x509_cred)
    {
      GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
924
      gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
925 926 927 928 929 930
      XPROCESS (proc)->gnutls_x509_cred = NULL;
    }

  if (XPROCESS (proc)->gnutls_anon_cred)
    {
      GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
931
      gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
932 933 934
      XPROCESS (proc)->gnutls_anon_cred = NULL;
    }

Chong Yidong's avatar
Chong Yidong committed
935
  if (XPROCESS (proc)->gnutls_state)
936
    {
937
      gnutls_deinit (XPROCESS (proc)->gnutls_state);
Chong Yidong's avatar
Chong Yidong committed
938 939 940
      XPROCESS (proc)->gnutls_state = NULL;
      if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
	GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
941 942
    }

943 944 945
  if (XPROCESS (proc)->gnutls_certificates)
    gnutls_deinit_certificates (XPROCESS (proc));

946
  XPROCESS (proc)->gnutls_p = false;
947 948 949
  return Qt;
}

950 951 952 953 954 955
DEFUN ("gnutls-asynchronous-parameters", Fgnutls_asynchronous_parameters,
       Sgnutls_asynchronous_parameters, 2, 2, 0,
       doc: /* Mark this process as being a pre-init GnuTLS process.
The second parameter is the list of parameters to feed to gnutls-boot
to finish setting up the connection. */)
  (Lisp_Object proc, Lisp_Object params)
956 957 958
{
  CHECK_PROCESS (proc);

959
  XPROCESS (proc)->gnutls_boot_parameters = params;
960 961 962
  return Qnil;
}

Ted Zlatanov's avatar
Ted Zlatanov committed
963
DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
964
       doc: /* Return the GnuTLS init stage of process PROC.
Ted Zlatanov's avatar
Ted Zlatanov committed
965
See also `gnutls-boot'.  */)
966
  (Lisp_Object proc)
Ted Zlatanov's avatar
Ted Zlatanov committed
967 968 969
{
  CHECK_PROCESS (proc);

970
  return make_fixnum (GNUTLS_INITSTAGE (proc));
Ted Zlatanov's avatar
Ted Zlatanov committed
971 972 973
}

DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
974 975
       doc: /* Return t if ERROR indicates a GnuTLS problem.
ERROR is an integer or a symbol with an integer `gnutls-code' property.
976 977
usage: (gnutls-errorp ERROR)  */
       attributes: const)
978
  (Lisp_Object err)
Ted Zlatanov's avatar
Ted Zlatanov committed
979
{
980 981 982
  if (EQ (err, Qt)
      || EQ (err, Qgnutls_e_again))
    return Qnil;
Ted Zlatanov's avatar
Ted Zlatanov committed
983 984 985 986 987

  return Qt;
}

DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0,
988
       doc: /* Return non-nil if ERROR is fatal.
989
ERROR is an integer or a symbol with an integer `gnutls-code' property.
990
Usage: (gnutls-error-fatalp ERROR)  */)
991
  (Lisp_Object err)
Ted Zlatanov's avatar
Ted Zlatanov committed
992 993 994 995 996 997 998
{
  Lisp_Object code;

  if (EQ (err, Qt)) return Qnil;

  if (SYMBOLP (err))
    {
999
      code = Fget (err, Qgnutls_code);
1000
      if (NUMBERP (code))
1001 1002 1003 1004 1005 1006 1007
	{
	  err = code;
	}
      else
	{
	  error ("Symbol has no numeric gnutls-code property");
	}
Ted Zlatanov's avatar
Ted Zlatanov committed
1008 1009
    }

1010
  if (! TYPE_RANGED_FIXNUMP (int, err))
Ted Zlatanov's avatar
Ted Zlatanov committed
1011 1012
    error ("Not an error symbol or code");

1013
  if (0 == gnutls_error_is_fatal (XFIXNUM (err)))
Ted Zlatanov's avatar
Ted Zlatanov committed
1014 1015 1016 1017 1018 1019
    return Qnil;

  return Qt;
}

DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0,
1020 1021 1022 1023
       doc: /* Return a description of ERROR.
ERROR is an integer or a symbol with an integer `gnutls-code' property.
usage: (gnutls-error-string ERROR)  */)
  (Lisp_Object err)
Ted Zlatanov's avatar
Ted Zlatanov committed
1024 1025 1026 1027 1028 1029 1030
{
  Lisp_Object code;

  if (EQ (err, Qt)) return build_string ("Not an error");

  if (SYMBOLP (err))
    {
1031
      code = Fget (err, Qgnutls_code);
1032
      if (NUMBERP (code))
1033 1034 1035 1036 1037 1038 1039
	{
	  err = code;
	}
      else
	{
	  return build_string ("Symbol has no numeric gnutls-code property");
	}
Ted Zlatanov's avatar
Ted Zlatanov committed
1040 1041
    }

1042
  if (! TYPE_RANGED_FIXNUMP (int, err))
Ted Zlatanov's avatar
Ted Zlatanov committed
1043 1044
    return build_string ("Not an error symbol or code");

1045
  return build_string (emacs_gnutls_strerror (XFIXNUM (err)));
Ted Zlatanov's avatar
Ted Zlatanov committed
1046 1047 1048
}

DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
1049
       doc: /* Deallocate GnuTLS resources associated with process PROC.
Ted Zlatanov's avatar
Ted Zlatanov committed
1050
See also `gnutls-init'.  */)
1051
  (Lisp_Object proc)
Ted Zlatanov's avatar
Ted Zlatanov committed
1052
{
1053
  return emacs_gnutls_deinit (proc);
Ted Zlatanov's avatar
Ted Zlatanov committed
1054 1055
}

1056
static Lisp_Object
1057
gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
1058
{
1059
  ptrdiff_t prefix_length = strlen (prefix);
1060 1061 1062
  ptrdiff_t retlen;
  if (INT_MULTIPLY_WRAPV (buf_size, 3, &retlen)
      || INT_ADD_WRAPV (prefix_length - (buf_size != 0), retlen, &retlen))
1063
    string_overflow ();
1064
  Lisp_Object ret = make_uninit_string (retlen);
1065
  char *string = SSDATA (ret);
1066 1067
  strcpy (string, prefix);

1068
  for (ptrdiff_t i = 0; i < buf_size; i++)
1069
    sprintf (string + i * 3 + prefix_length,
1070
	     i == buf_size - 1 ? "%02x" : "%02x:",
1071
	     buf[i]);
1072 1073 1074 1075

  return ret;
}

1076
static Lisp_Object
1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104
emacs_gnutls_certificate_export_pem (gnutls_x509_crt_t cert)
{
  size_t size = 0;
  int err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, NULL, &size);
  check_memory_full (err);

  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
      unsigned char *buf = xmalloc(size * sizeof (unsigned char));
      err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, buf, &size);
      check_memory_full (err);

      if (err < GNUTLS_E_SUCCESS)
        {
          xfree (buf);
          error ("GnuTLS certificate export error: %s", emacs_gnutls_strerror (err));
        }

      return build_string(buf);
    }
  else if (err < GNUTLS_E_SUCCESS)
    error ("GnuTLS certificate export error: %s", emacs_gnutls_strerror (err));

  return Qnil;
}

static Lisp_Object
emacs_gnutls_certificate_details (gnutls_x509_crt_t cert)
1105 1106 1107
{
  Lisp_Object res = Qnil;
  int err;
1108
  size_t buf_size;
1109 1110 1111

  /* Version. */
  {
1112
    int version = gnutls_x509_crt_get_version (cert);
Paul Eggert's avatar
Paul Eggert committed
1113
    check_memory_full (version);
1114 1115
    if (version >= GNUTLS_E_SUCCESS)
      res = nconc2 (res, list2 (intern (":version"),
1116
				make_fixnum (version)));
1117 1118 1119
  }

  /* Serial. */
1120
  buf_size = 0;
1121
  err = gnutls_x509_crt_get_serial (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1122
  check_memory_full (err);
1123 1124
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1125
      void *serial = xmalloc (buf_size);
1126
      err = gnutls_x509_crt_get_serial (cert, serial, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1127
      check_memory_full (err);
1128 1129 1130
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":serial-number"),
				  gnutls_hex_string (serial, buf_size, "")));
1131
      xfree (serial);
1132
    }
1133 1134

  /* Issuer. */
1135
  buf_size = 0;
1136
  err = gnutls_x509_crt_get_issuer_dn (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1137
  check_memory_full (err);
1138 1139
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1140
      char *dn = xmalloc (buf_size);
1141
      err = gnutls_x509_crt_get_issuer_dn (cert, dn, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1142
      check_memory_full (err);
1143 1144 1145
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":issuer"),
				  make_string (dn, buf_size)));
1146
      xfree (dn);
1147
    }
1148 1149 1150

  /* Validity. */
  {
1151 1152 1153
    /* Add 1 to the buffer size, since 1900 is added to tm_year and
       that might add 1 to the year length.  */
    char buf[INT_STRLEN_BOUND (int) + 1 + sizeof "-12-31"];
1154
    struct tm t;
1155
    time_t tim = gnutls_x509_crt_get_activation_time (cert);
1156

1157
    if (gmtime_r (&tim, &t) && strftime (buf, sizeof buf, "%Y-%m-%d", &t))
1158 1159
      res = nconc2 (res, list2 (intern (":valid-from"), build_string (buf)));

1160
    tim = gnutls_x509_crt_get_expiration_time (cert);
1161
    if (gmtime_r (&tim, &t) && strftime (buf, sizeof buf, "%Y-%m-%d", &t))
1162 1163 1164 1165
      res = nconc2 (res, list2 (intern (":valid-to"), build_string (buf)));
  }

  /* Subject. */
1166
  buf_size = 0;
1167
  err = gnutls_x509_crt_get_dn (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1168
  check_memory_full (err);
1169 1170
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1171
      char *dn = xmalloc (buf_size);
1172
      err = gnutls_x509_crt_get_dn (cert, dn, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1173
      check_memory_full (err);
1174 1175 1176
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":subject"),
				  make_string (dn, buf_size)));
1177
      xfree (dn);
1178
    }
1179 1180 1181 1182 1183

  /* SubjectPublicKeyInfo. */
  {
    unsigned int bits;

1184
    err = gnutls_x509_crt_get_pk_algorithm (cert, &bits);
Paul Eggert's avatar
Paul Eggert committed
1185
    check_memory_full (err);
1186 1187
    if (err >= GNUTLS_E_SUCCESS)
      {
1188
	const char *name = gnutls_pk_algorithm_get_name (err);
1189 1190 1191 1192
	if (name)
	  res = nconc2 (res, list2 (intern (":public-key-algorithm"),
				    build_string (name)));

1193 1194
	name = gnutls_sec_param_get_name (gnutls_pk_bits_to_sec_param
					  (err, bits));
1195
	res = nconc2 (res, list2 (intern (":certificate-security-level"),
1196
				  build_string (name)));
1197
      }
1198 1199 1200
  }

  /* Unique IDs. */
1201
  buf_size = 0;
1202
  err = gnutls_x509_crt_get_issuer_unique_id (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1203
  check_memory_full (err);
1204 1205
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1206
      char *buf = xmalloc (buf_size);
1207
      err = gnutls_x509_crt_get_issuer_unique_id (cert, buf, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1208
      check_memory_full (err);
1209 1210 1211
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":issuer-unique-id"),
				  make_string (buf, buf_size)));
1212
      xfree (buf);
1213
    }
1214

1215
  buf_size = 0;
1216
  err = gnutls_x509_crt_get_subject_unique_id (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1217
  check_memory_full (err);
1218 1219
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1220
      char *buf = xmalloc (buf_size);
1221
      err = gnutls_x509_crt_get_subject_unique_id (cert, buf, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1222
      check_memory_full (err);
1223 1224 1225
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":subject-unique-id"),
				  make_string (buf, buf_size)));
1226
      xfree (buf);
1227
    }
1228

1229
  /* Signature. */
1230
  err = gnutls_x509_crt_get_signature_algorithm (cert);
Paul Eggert's avatar
Paul Eggert committed
1231
  check_memory_full (err);
1232 1233
  if (err >= GNUTLS_E_SUCCESS)
    {
1234
      const char *name = gnutls_sign_get_name (err);
1235 1236 1237 1238 1239
      if (name)
	res = nconc2 (res, list2 (intern (":signature-algorithm"),
				  build_string (name)));
    }

1240
  /* Public key ID. */
1241
  buf_size = 0;
1242
  err = gnutls_x509_crt_get_key_id (cert, 0, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1243
  check_memory_full (err);
1244 1245
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1246
      void *buf = xmalloc (buf_size);
1247
      err = gnutls_x509_crt_get_key_id (cert, 0, buf, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1248
      check_memory_full (err);
1249 1250
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":public-key-id"),
1251 1252
				  gnutls_hex_string (buf, buf_size, "sha1:")));
      xfree (buf);
1253
    }
1254 1255

  /* Certificate fingerprint. */
1256
  buf_size = 0;
1257 1258
  err = gnutls_x509_crt_get_fingerprint (cert, GNUTLS_DIG_SHA1,
					 NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1259
  check_memory_full (err);
1260 1261
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1262
      void *buf = xmalloc (buf_size);
1263 1264
      err = gnutls_x509_crt_get_fingerprint (cert, GNUTLS_DIG_SHA1,
					     buf, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1265
      check_memory_full (err);
1266 1267
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":certificate-id"),
1268 1269
				  gnutls_hex_string (buf, buf_size, "sha1:")));
      xfree (buf);
1270
    }
1271

1272 1273 1274 1275
  /* PEM */
  res = nconc2 (res, list2 (intern (":pem"),
                            emacs_gnutls_certificate_export_pem(cert)));

1276 1277 1278
  return res;
}

1279
DEFUN ("gnutls-peer-status-warning-describe", Fgnutls_peer_status_warning_describe, Sgnutls_peer_status_warning_describe, 1, 1, 0,
1280
       doc: /* Describe the warning of a GnuTLS peer status from `gnutls-peer-status'.  */)
1281 1282 1283 1284
  (Lisp_Object status_symbol)
{
  CHECK_SYMBOL (status_symbol);

1285
  if (EQ (status_symbol, intern (":invalid")))
1286 1287
    return build_string ("certificate could not be verified");

1288
  if (EQ (status_symbol, intern (":revoked")))
1289 1290
    return build_string ("certificate was revoked (CRL)");

1291
  if (EQ (status_symbol, intern (":self-signed")))
1292 1293
    return build_string ("certificate signer was not found (self-signed)");

1294 1295 1296 1297
  if (EQ (status_symbol, intern (":unknown-ca")))
    return build_string ("the certificate was signed by an unknown "
                         "and t