gnutls.c 94.8 KB
Newer Older
Ted Zlatanov's avatar
Ted Zlatanov committed
1
/* GnuTLS glue for GNU Emacs.
2
   Copyright (C) 2010-2020 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
#ifdef HAVE_GNUTLS
Ted Zlatanov's avatar
Ted Zlatanov committed
31

32 33 34
# if GNUTLS_VERSION_NUMBER >= 0x030014
#  define HAVE_GNUTLS_X509_SYSTEM_TRUST
# endif
35

36 37 38
# if GNUTLS_VERSION_NUMBER >= 0x030200
#  define HAVE_GNUTLS_CIPHER_GET_IV_SIZE
# endif
39

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

45 46 47
# if GNUTLS_VERSION_NUMBER >= 0x030205
#  define HAVE_GNUTLS_EXT__DUMBFW
# endif
48

49 50 51 52 53 54 55
# if GNUTLS_VERSION_NUMBER >= 0x030400
#  define HAVE_GNUTLS_ETM_STATUS
# endif

# if GNUTLS_VERSION_NUMBER < 0x030600
#  define HAVE_GNUTLS_COMPRESSION_GET
# endif
56

57 58
/* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was
   exported only since 3.3.0. */
59 60 61
# if GNUTLS_VERSION_NUMBER >= 0x030300
#  define HAVE_GNUTLS_MAC_GET_NONCE_SIZE
# endif
62

63 64 65
# if GNUTLS_VERSION_NUMBER >= 0x030501
#  define HAVE_GNUTLS_EXT_GET_NAME
# endif
66

67 68 69 70 71 72
/* 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.  */
73 74 75
# if GNUTLS_VERSION_NUMBER >= 0x030501
#  define HAVE_GNUTLS_AEAD
# endif
76 77 78

# ifdef WINDOWSNT
#  include <windows.h>
79
#  include "w32common.h"
80 81 82
#  include "w32.h"
# endif

83
static int emacs_gnutls_handle_error (gnutls_session_t, int);
84

85
static bool gnutls_global_initialized;
Ted Zlatanov's avatar
Ted Zlatanov committed
86

87
static void gnutls_log_function (int, const char *);
88
static void gnutls_log_function2 (int, const char *, const char *);
89
# ifdef HAVE_GNUTLS3
90
static void gnutls_audit_log_function (gnutls_session_t, const char *);
91
# endif
92

93 94 95 96
enum extra_peer_verification
{
    CERTIFICATE_NOT_MATCHING = 2
};
97

98

99
# ifdef WINDOWSNT
100

101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
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));
124
#  ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
125 126
DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust,
	    (gnutls_certificate_credentials_t));
127
#  endif
128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
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));
144
#  ifdef HAVE_GNUTLS3
145
DEF_DLL_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func));
146
#  endif
147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166
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 *));
167 168
DEF_DLL_FN (int, gnutls_x509_crt_check_issuer,
              (gnutls_x509_crt_t, gnutls_x509_crt_t));
169
DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
170
DEF_DLL_FN (int, gnutls_x509_crt_export,
171
            (gnutls_x509_crt_t, gnutls_x509_crt_fmt_t, void *, size_t *));
172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
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 *));
193 194 195
DEF_DLL_FN (int, gnutls_x509_crt_print,
            (gnutls_x509_crt_t, gnutls_certificate_print_formats_t,
             gnutls_datum_t *));
196
DEF_DLL_FN (const char *, gnutls_pk_algorithm_get_name,
197 198 199 200 201 202 203 204 205 206 207
	    (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));
208 209
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));
210 211 212 213
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));
214
DEF_DLL_FN (const char *, gnutls_kx_get_name, (gnutls_kx_algorithm_t));
215 216
DEF_DLL_FN (gnutls_protocol_t, gnutls_protocol_get_version,
	    (gnutls_session_t));
217
DEF_DLL_FN (const char *, gnutls_protocol_get_name, (gnutls_protocol_t));
218 219
DEF_DLL_FN (gnutls_cipher_algorithm_t, gnutls_cipher_get,
	    (gnutls_session_t));
220
DEF_DLL_FN (const char *, gnutls_cipher_get_name,
221 222
	    (gnutls_cipher_algorithm_t));
DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
223
DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
224
#  ifdef HAVE_GNUTLS_COMPRESSION_GET
225 226 227 228
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));
229
#  endif
230
DEF_DLL_FN (unsigned, gnutls_safe_renegotiation_status, (gnutls_session_t));
231

232
#  ifdef HAVE_GNUTLS3
233
DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
234
DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
235
#   ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
236
DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
237
#   endif
238
DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t));
239
#   ifdef HAVE_GNUTLS_DIGEST_LIST
240 241
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));
242
#   endif
243
DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void));
244
#   ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
245
DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t));
246
#   endif
247 248
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));
249
#   ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
250
DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t));
251
#   endif
252 253 254
DEF_DLL_FN (int, gnutls_cipher_init,
	    (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t,
	     const gnutls_datum_t *, const gnutls_datum_t *));
255 256 257 258 259 260
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));
261
#   ifdef HAVE_GNUTLS_AEAD
262 263 264 265 266 267 268 269 270 271
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 *));
272
#   endif
273 274 275
#   ifdef HAVE_GNUTLS_ETM_STATUS
DEF_DLL_FN (unsigned, gnutls_session_etm_status, (gnutls_session_t));
#   endif
276 277 278 279 280 281
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 *));
282 283
  DEF_DLL_FN (int, gnutls_hash_init,
	    (gnutls_hash_hd_t *, gnutls_digest_algorithm_t));
284 285 286 287
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 *));
288 289 290
#   ifdef HAVE_GNUTLS_EXT_GET_NAME
DEF_DLL_FN (const char *, gnutls_ext_get_name, (unsigned int));
#   endif
291
#  endif	 /* HAVE_GNUTLS3 */
292

293
static gnutls_free_function *gnutls_free_func;
294

295
static bool
296
init_gnutls_functions (void)
297 298
{
  HMODULE library;
299
  int max_log_level = 1;
300

301
  if (!(library = w32_delayed_load (Qgnutls)))
302
    {
303
      GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
304 305 306
      return 0;
    }

307 308 309 310 311 312 313 314 315 316 317
  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);
318
#  ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
319
  LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust);
320
#  endif
321 322 323 324 325 326 327 328 329 330
  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);
331
#  ifdef HAVE_GNUTLS3
332
  LOAD_DLL_FN (library, gnutls_global_set_audit_log_function);
333
#  endif
334 335 336 337 338 339 340 341 342 343 344 345 346
  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);
347
  LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer);
348
  LOAD_DLL_FN (library, gnutls_x509_crt_deinit);
349
  LOAD_DLL_FN (library, gnutls_x509_crt_export);
350 351 352 353 354 355 356 357 358 359
  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);
360
  LOAD_DLL_FN (library, gnutls_x509_crt_print);
361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377
  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);
378
#  ifdef HAVE_GNUTLS_COMPRESSION_GET
379 380
  LOAD_DLL_FN (library, gnutls_compression_get);
  LOAD_DLL_FN (library, gnutls_compression_get_name);
381
#  endif
382
  LOAD_DLL_FN (library, gnutls_safe_renegotiation_status);
383
#  ifdef HAVE_GNUTLS3
384
  LOAD_DLL_FN (library, gnutls_rnd);
385
  LOAD_DLL_FN (library, gnutls_mac_list);
386
#   ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
387
  LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
388
#   endif
389
  LOAD_DLL_FN (library, gnutls_mac_get_key_size);
390
#   ifdef HAVE_GNUTLS_DIGEST_LIST
391 392
  LOAD_DLL_FN (library, gnutls_digest_list);
  LOAD_DLL_FN (library, gnutls_digest_get_name);
393
#   endif
394
  LOAD_DLL_FN (library, gnutls_cipher_list);
395
#   ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
396
  LOAD_DLL_FN (library, gnutls_cipher_get_iv_size);
397
#   endif
398 399
  LOAD_DLL_FN (library, gnutls_cipher_get_key_size);
  LOAD_DLL_FN (library, gnutls_cipher_get_block_size);
400
#   ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
401
  LOAD_DLL_FN (library, gnutls_cipher_get_tag_size);
402
#   endif
403 404 405 406
  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);
407
  LOAD_DLL_FN (library, gnutls_cipher_decrypt2);
408
#   ifdef HAVE_GNUTLS_AEAD
409 410 411 412
  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);
413 414 415
#   endif
#   ifdef HAVE_GNUTLS_ETM_STATUS
  LOAD_DLL_FN (library, gnutls_session_etm_status);
416
#   endif
417 418 419 420 421 422 423 424 425 426
  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);
427 428 429
#   ifdef HAVE_GNUTLS_EXT_GET_NAME
  LOAD_DLL_FN (library, gnutls_ext_get_name);
#   endif
430
#  endif	 /* HAVE_GNUTLS3 */
431

432 433 434 435 436 437 438
  /* gnutls_free is a variable inside GnuTLS, whose value is the
     "free" function.  So it needs special handling.  */
  gnutls_free_func = (gnutls_free_function *) GetProcAddress (library,
							      "gnutls_free");
  if (!gnutls_free_func)
    return false;

439
  max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
440
  {
441
    Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from));
442 443 444 445
    GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
                 STRINGP (name) ? (const char *) SDATA (name) : "unknown");
  }

446 447 448
  return 1;
}

449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480
#  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
481 482 483 484
#  ifdef HAVE_GNUTLS_COMPRESSION_GET
#   define gnutls_compression_get fn_gnutls_compression_get
#   define gnutls_compression_get_name fn_gnutls_compression_get_name
#  endif
485
#  define gnutls_safe_renegotiation_status fn_gnutls_safe_renegotiation_status
486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504
#  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
505
#  define gnutls_x509_crt_export fn_gnutls_x509_crt_export
506 507 508 509 510 511 512 513
#  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
514
#  define gnutls_x509_crt_print fn_gnutls_x509_crt_print
515 516 517 518 519 520 521 522 523
#  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
524 525 526
#   ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
#    define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
#   endif
527
#  define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
528
#  ifdef HAVE_GNUTLS_DIGEST_LIST
529 530 531
#   define gnutls_digest_list fn_gnutls_digest_list
#   define gnutls_digest_get_name fn_gnutls_digest_get_name
#  endif
532
#  define gnutls_cipher_list fn_gnutls_cipher_list
533
#  ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
534 535
#   define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
#  endif
536 537
#  define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
#  define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
538
#  ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
539 540
#   define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
#  endif
541 542 543 544 545 546
#  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
547 548 549 550
#    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
551
#   endif
552 553 554
#   ifdef HAVE_GNUTLS_ETM_STATUS
#    define gnutls_session_etm_status fn_gnutls_session_etm_status
#   endif
555 556 557 558 559 560 561 562 563 564
#  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
565 566 567
#   ifdef HAVE_GNUTLS_EXT_GET_NAME
#    define gnutls_ext_get_name fn_gnutls_ext_get_name
#   endif
568
#  endif	 /* HAVE_GNUTLS3 */
569

570 571 572
/* gnutls_free_func is a data pointer to a variable which holds an
   address of a function.  We use #undef because MinGW64 defines
   gnutls_free as a macro as well in the GnuTLS headers.  */
573 574
#  undef gnutls_free
#  define gnutls_free (*gnutls_free_func)
575

576 577 578 579 580 581 582
/* 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);
}
583

584
# endif	/* WINDOWSNT */
585 586


587 588 589 590 591 592 593 594 595 596 597
/* 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);
}

598
# ifdef HAVE_GNUTLS3
599
/* Log a simple audit message.  */
600
static void
601
gnutls_audit_log_function (gnutls_session_t session, const char *string)
602 603 604 605 606 607
{
  if (global_gnutls_log_level >= 1)
    {
      message ("gnutls.c: [audit] %s", string);
    }
}
608
# endif
609

610
/* Log a simple message.  */
611
static void
612
gnutls_log_function (int level, const char *string)
613 614 615 616
{
  message ("gnutls.c: [%d] %s", level, string);
}

617
/* Log a message and a string.  */
618
static void
619
gnutls_log_function2 (int level, const char *string, const char *extra)
620 621 622 623
{
  message ("gnutls.c: [%d] %s %s", level, string, extra);
}

624 625 626 627 628
int
gnutls_try_handshake (struct Lisp_Process *proc)
{
  gnutls_session_t state = proc->gnutls_state;
  int ret;
629
  bool non_blocking = proc->is_non_blocking_client;
630

631 632 633 634
  if (proc->gnutls_complete_negotiation_p)
    non_blocking = false;

  if (non_blocking)
635 636
    proc->gnutls_p = true;

637
  while ((ret = gnutls_handshake (state)) < 0)
638
    {
639 640 641 642 643 644 645
      do
	ret = gnutls_handshake (state);
      while (ret == GNUTLS_E_INTERRUPTED);

      if (0 <= ret || emacs_gnutls_handle_error (state, ret) == 0
	  || non_blocking)
	break;
646
      maybe_quit ();
647 648 649 650 651 652 653 654 655 656 657
    }

  proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;

  if (ret == GNUTLS_E_SUCCESS)
    {
      /* Here we're finally done.  */
      proc->gnutls_initstage = GNUTLS_STAGE_READY;
    }
  else
    {
658
      /* check_memory_full (gnutls_alert_send_appropriate (state, ret));  */
659 660 661 662
    }
  return ret;
}

663
# ifndef WINDOWSNT
664 665 666 667 668 669 670
static int
emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
{
  int err = errno;

  switch (err)
    {
671
#  ifdef _AIX
672
      /* This is taken from the GnuTLS system_errno function circa 2016;
673
	 see <https://savannah.gnu.org/support/?107464>.  */
674 675 676
    case 0:
      errno = EAGAIN;
      /* Fall through.  */
677
#  endif
678 679 680 681 682 683 684 685
    case EINPROGRESS:
    case ENOTCONN:
      return EAGAIN;

    default:
      return err;
    }
}
686
# endif	/* !WINDOWSNT */
687

688
static int
689 690 691 692 693
emacs_gnutls_handshake (struct Lisp_Process *proc)
{
  gnutls_session_t state = proc->gnutls_state;

  if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
694
    return -1;
695 696

  if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
697
    {
698
# ifdef WINDOWSNT
699
      /* On W32 we cannot transfer socket handles between different runtime
Andreas Schwab's avatar
Andreas Schwab committed
700 701
	 libraries, so we tell GnuTLS to use our special push/pull
	 functions.  */
702 703 704 705 706
      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);
707
# else
708
      /* This is how GnuTLS takes sockets: as file descriptors passed
Andreas Schwab's avatar
Andreas Schwab committed
709 710
	 in.  For an Emacs process socket, infd and outfd are the
	 same but we use this two-argument version for clarity.  */
711 712 713
      gnutls_transport_set_ptr2 (state,
				 (void *) (intptr_t) proc->infd,
				 (void *) (intptr_t) proc->outfd);
714 715 716
      if (proc->is_non_blocking_client)
	gnutls_transport_set_errno_function (state,
					     emacs_gnutls_nonblock_errno);
717
# endif
718

719 720
      proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
    }
721

722
  return gnutls_try_handshake (proc);
723 724
}

725
ptrdiff_t
726 727
emacs_gnutls_record_check_pending (gnutls_session_t state)
{
728
  return gnutls_record_check_pending (state);
729 730
}

731
# ifdef WINDOWSNT
732 733 734
void
emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
{
735
  gnutls_transport_set_errno (state, err);
736
}
737
# endif
738

739 740
ptrdiff_t
emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
Ted Zlatanov's avatar
Ted Zlatanov committed
741
{
742 743
  gnutls_session_t state = proc->gnutls_state;

744 745 746 747 748
  if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
    {
      errno = EAGAIN;
      return 0;
    }
Ted Zlatanov's avatar
Ted Zlatanov committed
749

750
  ptrdiff_t bytes_written = 0;
Ted Zlatanov's avatar
Ted Zlatanov committed
751 752 753

  while (nbyte > 0)
    {
754 755 756 757
      ssize_t rtnval;
      do
	rtnval = gnutls_record_send (state, buf, nbyte);
      while (rtnval == GNUTLS_E_INTERRUPTED);
Ted Zlatanov's avatar
Ted Zlatanov committed
758

759
      if (rtnval < 0)
Andreas Schwab's avatar
Andreas Schwab committed
760
	{
761 762
	  emacs_gnutls_handle_error (state, rtnval);
	  break;
Andreas Schwab's avatar
Andreas Schwab committed
763
	}
Ted Zlatanov's avatar
Ted Zlatanov committed
764 765 766 767 768 769 770 771 772

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

  return (bytes_written);
}

773 774
ptrdiff_t
emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
Ted Zlatanov's avatar
Ted Zlatanov committed
775
{
776 777
  gnutls_session_t state = proc->gnutls_state;

778
  if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
779 780 781 782
    {
      errno = EAGAIN;
      return -1;
    }
783

784 785 786 787 788
  ssize_t rtnval;
  do
    rtnval = gnutls_record_recv (state, buf, nbyte);
  while (rtnval == GNUTLS_E_INTERRUPTED);

789 790
  if (rtnval >= 0)
    return rtnval;
791 792 793
  else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
    /* The peer closed the connection. */
    return 0;
794 795
  else
    return emacs_gnutls_handle_error (state, rtnval);
Ted Zlatanov's avatar
Ted Zlatanov committed
796 797
}

798 799 800 801 802 803 804
static char const *
emacs_gnutls_strerror (int err)
{
  char const *str = gnutls_strerror (err);
  return str ? str : "unknown";
}

805
/* Report a GnuTLS error to the user.
806 807 808 809
   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
810 811
emacs_gnutls_handle_error (gnutls_session_t session, int err)
{
812
  int ret;
813 814 815

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

816 817
  check_memory_full (err);

818 819
  int max_log_level
    = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
820 821 822

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

823
  char const *str = emacs_gnutls_strerror (err);
824
  int errnum = EINVAL;
825

826
  if (gnutls_error_is_fatal (err))
827
    {
828 829 830 831
      int level = 1;
      /* Mostly ignore "The TLS connection was non-properly
	 terminated" message which just means that the peer closed the
	 connection.  */
832
# ifdef HAVE_GNUTLS3
833 834
      if (err == GNUTLS_E_PREMATURE_TERMINATION)
	level = 3;
835
# endif
836 837

      GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
838
      ret = 0;
839 840 841
    }
  else
    {
842
      ret = -1;
843 844 845 846 847 848 849 850

      switch (err)
        {
        case GNUTLS_E_AGAIN:
          GNUTLS_LOG2 (3,
                       max_log_level,
                       "retry:",
                       str);
851
	  FALLTHROUGH;
852 853 854 855 856 857
        default:
          GNUTLS_LOG2 (1,
                       max_log_level,
                       "non-fatal error:",
                       str);
        }
858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877

      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
	}
878 879 880 881 882
    }

  if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
      || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
    {
883
      int alert = gnutls_alert_get (session);
884
      int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
885
      str = gnutls_alert_get_name (alert);
886 887 888 889 890
      if (!str)
	str = "unknown";

      GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str);
    }
891 892

  errno = errnum;
893 894 895
  return ret;
}

Ted Zlatanov's avatar
Ted Zlatanov committed
896
/* convert an integer error to a Lisp_Object; it will be either a
897
   known symbol like 'gnutls_e_interrupted' and 'gnutls_e_again' or
Ted Zlatanov's avatar
Ted Zlatanov committed
898 899
   simply the integer value of the error.  GNUTLS_E_SUCCESS is mapped
   to Qt.  */
900
static Lisp_Object
901
gnutls_make_error (int err)
Ted Zlatanov's avatar
Ted Zlatanov committed
902
{
903
  switch (err)
904 905 906 907 908 909 910 911 912 913
    {
    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
914

915
  check_memory_full (err);
916
  return make_fixnum (err);
Ted Zlatanov's avatar
Ted Zlatanov committed
917 918
}

919 920 921 922 923 924 925 926 927 928 929 930 931
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;
}

932 933 934 935 936 937 938
Lisp_Object
emacs_gnutls_deinit (Lisp_Object proc)
{
  int log_level;

  CHECK_PROCESS (proc);

939
  if (! XPROCESS (proc)->gnutls_p)
940 941 942 943 944 945 946
    return Qnil;

  log_level = XPROCESS (proc)->gnutls_log_level;

  if (XPROCESS (proc)->gnutls_x509_cred)
    {
      GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
947
      gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
948 949 950 951 952 953
      XPROCESS (proc)->gnutls_x509_cred = NULL;
    }

  if (XPROCESS (proc)->gnutls_anon_cred)
    {
      GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
954
      gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
955 956 957
      XPROCESS (proc)->gnutls_anon_cred = NULL;
    }

Chong Yidong's avatar
Chong Yidong committed
958
  if (XPROCESS (proc)->gnutls_state)
959
    {
960
      gnutls_deinit (XPROCESS (proc)->gnutls_state);
Chong Yidong's avatar
Chong Yidong committed
961 962 963
      XPROCESS (proc)->gnutls_state = NULL;
      if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
	GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
964 965
    }

966 967 968
  if (XPROCESS (proc)->gnutls_certificates)
    gnutls_deinit_certificates (XPROCESS (proc));

969
  XPROCESS (proc)->gnutls_p = false;
970 971 972
  return Qt;
}

973 974 975 976 977 978
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)
979 980 981
{
  CHECK_PROCESS (proc);

982
  XPROCESS (proc)->gnutls_boot_parameters = params;
983 984 985
  return Qnil;
}

Ted Zlatanov's avatar
Ted Zlatanov committed
986
DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
987
       doc: /* Return the GnuTLS init stage of process PROC.
Ted Zlatanov's avatar
Ted Zlatanov committed
988
See also `gnutls-boot'.  */)
989
  (Lisp_Object proc)
Ted Zlatanov's avatar
Ted Zlatanov committed
990 991 992
{
  CHECK_PROCESS (proc);

993
  return make_fixnum (GNUTLS_INITSTAGE (proc));
Ted Zlatanov's avatar
Ted Zlatanov committed
994 995 996
}

DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
997 998
       doc: /* Return t if ERROR indicates a GnuTLS problem.
ERROR is an integer or a symbol with an integer `gnutls-code' property.
999 1000
usage: (gnutls-errorp ERROR)  */
       attributes: const)
1001
  (Lisp_Object err)
Ted Zlatanov's avatar
Ted Zlatanov committed
1002
{
1003 1004 1005
  if (EQ (err, Qt)
      || EQ (err, Qgnutls_e_again))
    return Qnil;
Ted Zlatanov's avatar
Ted Zlatanov committed
1006 1007 1008 1009 1010

  return Qt;
}

DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0,
1011
       doc: /* Return non-nil if ERROR is fatal.
1012
ERROR is an integer or a symbol with an integer `gnutls-code' property.
1013
Usage: (gnutls-error-fatalp ERROR)  */)
1014
  (Lisp_Object err)
Ted Zlatanov's avatar
Ted Zlatanov committed
1015 1016 1017 1018 1019 1020 1021
{
  Lisp_Object code;

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

  if (SYMBOLP (err))
    {
1022
      code = Fget (err, Qgnutls_code);
1023
      if (NUMBERP (code))
1024 1025 1026 1027 1028 1029 1030
	{
	  err = code;
	}
      else
	{
	  error ("Symbol has no numeric gnutls-code property");
	}
Ted Zlatanov's avatar
Ted Zlatanov committed
1031 1032
    }

1033
  if (! TYPE_RANGED_FIXNUMP (int, err))
Ted Zlatanov's avatar
Ted Zlatanov committed
1034 1035
    error ("Not an error symbol or code");

1036
  if (0 == gnutls_error_is_fatal (XFIXNUM (err)))
Ted Zlatanov's avatar
Ted Zlatanov committed
1037 1038 1039 1040 1041 1042
    return Qnil;

  return Qt;
}

DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0,
1043 1044 1045 1046
       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
1047 1048 1049 1050 1051 1052 1053
{
  Lisp_Object code;

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

  if (SYMBOLP (err))
    {
1054
      code = Fget (err, Qgnutls_code);
1055
      if (NUMBERP (code))
1056 1057 1058 1059 1060 1061 1062
	{
	  err = code;
	}
      else
	{
	  return build_string ("Symbol has no numeric gnutls-code property");
	}
Ted Zlatanov's avatar
Ted Zlatanov committed
1063 1064
    }

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

1068
  return build_string (emacs_gnutls_strerror (XFIXNUM (err)));
Ted Zlatanov's avatar
Ted Zlatanov committed
1069 1070 1071
}

DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
1072
       doc: /* Deallocate GnuTLS resources associated with process PROC.
Ted Zlatanov's avatar
Ted Zlatanov committed
1073
See also `gnutls-init'.  */)
1074
  (Lisp_Object proc)
Ted Zlatanov's avatar
Ted Zlatanov committed
1075
{
1076
  return emacs_gnutls_deinit (proc);
Ted Zlatanov's avatar
Ted Zlatanov committed
1077 1078
}

1079
static Lisp_Object
1080
gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
1081
{
1082
  ptrdiff_t prefix_length = strlen (prefix);
1083 1084 1085
  ptrdiff_t retlen;
  if (INT_MULTIPLY_WRAPV (buf_size, 3, &retlen)
      || INT_ADD_WRAPV (prefix_length - (buf_size != 0), retlen, &retlen))
1086
    string_overflow ();
1087
  Lisp_Object ret = make_uninit_string (retlen);
1088
  char *string = SSDATA (ret);
1089 1090
  strcpy (string, prefix);

1091
  for (ptrdiff_t i = 0; i < buf_size; i++)
1092
    sprintf (string + i * 3 + prefix_length,
1093
	     i == buf_size - 1 ? "%02x" : "%02x:",
1094
	     buf[i]);
1095 1096 1097 1098

  return ret;
}

1099
static Lisp_Object
1100 1101 1102 1103 1104 1105 1106 1107
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)
    {
1108 1109
      USE_SAFE_ALLOCA;
      char *buf = SAFE_ALLOCA (size);
1110 1111 1112 1113
      err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, buf, &size);
      check_memory_full (err);

      if (err < GNUTLS_E_SUCCESS)
1114 1115
	error ("GnuTLS certificate export error: %s",
	       emacs_gnutls_strerror (err));
1116

1117 1118 1119
      Lisp_Object result = build_string (buf);
      SAFE_FREE ();
      return result;
1120 1121 1122 1123 1124 1125 1126 1127 1128
    }
  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)
1129 1130 1131
{
  Lisp_Object res = Qnil;
  int err;
1132
  size_t buf_size;
1133 1134 1135

  /* Version. */
  {
1136
    int version = gnutls_x509_crt_get_version (cert);
Paul Eggert's avatar
Paul Eggert committed
1137
    check_memory_full (version);
1138 1139
    if (version >= GNUTLS_E_SUCCESS)
      res = nconc2 (res, list2 (intern (":version"),
1140
				make_fixnum (version)));
1141 1142 1143
  }

  /* Serial. */
1144
  buf_size = 0;
1145
  err = gnutls_x509_crt_get_serial (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1146
  check_memory_full (err);
1147 1148
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1149
      void *serial = xmalloc (buf_size);
1150
      err = gnutls_x509_crt_get_serial (cert, serial, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1151
      check_memory_full (err);
1152 1153 1154
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":serial-number"),
				  gnutls_hex_string (serial, buf_size, "")));
1155
      xfree (serial);
1156
    }
1157 1158

  /* Issuer. */
1159
  buf_size = 0;
1160
  err = gnutls_x509_crt_get_issuer_dn (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1161
  check_memory_full (err);
1162 1163
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1164
      char *dn = xmalloc (buf_size);
1165
      err = gnutls_x509_crt_get_issuer_dn (cert, dn, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1166
      check_memory_full (err);
1167 1168 1169
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":issuer"),
				  make_string (dn, buf_size)));
1170
      xfree (dn);
1171
    }
1172 1173 1174

  /* Validity. */
  {
1175 1176 1177
    /* 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"];
1178
    struct tm t;
1179
    time_t tim = gnutls_x509_crt_get_activation_time (cert);
1180

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

1184
    tim = gnutls_x509_crt_get_expiration_time (cert);
1185
    if (gmtime_r (&tim, &t) && strftime (buf, sizeof buf, "%Y-%m-%d", &t))
1186 1187 1188 1189
      res = nconc2 (res, list2 (intern (":valid-to"), build_string (buf)));
  }

  /* Subject. */
1190
  buf_size = 0;
1191
  err = gnutls_x509_crt_get_dn (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1192
  check_memory_full (err);
1193 1194
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1195
      char *dn = xmalloc (buf_size);
1196
      err = gnutls_x509_crt_get_dn (cert, dn, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1197
      check_memory_full (err);
1198 1199 1200
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":subject"),
				  make_string (dn, buf_size)));
1201
      xfree (dn);
1202
    }
1203 1204 1205 1206 1207

  /* SubjectPublicKeyInfo. */
  {
    unsigned int bits;

1208
    err = gnutls_x509_crt_get_pk_algorithm (cert, &bits);
Paul Eggert's avatar
Paul Eggert committed
1209
    check_memory_full (err);
1210 1211
    if (err >= GNUTLS_E_SUCCESS)
      {
1212
	const char *name = gnutls_pk_algorithm_get_name (err);
1213 1214 1215 1216
	if (name)
	  res = nconc2 (res, list2 (intern (":public-key-algorithm"),
				    build_string (name)));

1217 1218
	name = gnutls_sec_param_get_name (gnutls_pk_bits_to_sec_param
					  (err, bits));
1219
	res = nconc2 (res, list2 (intern (":certificate-security-level"),
1220
				  build_string (name)));
1221
      }
1222 1223 1224
  }

  /* Unique IDs. */
1225
  buf_size = 0;
1226
  err = gnutls_x509_crt_get_issuer_unique_id (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1227
  check_memory_full (err);
1228 1229
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1230
      char *buf = xmalloc (buf_size);
1231
      err = gnutls_x509_crt_get_issuer_unique_id (cert, buf, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1232
      check_memory_full (err);
1233 1234 1235
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":issuer-unique-id"),
				  make_string (buf, buf_size)));
1236
      xfree (buf);
1237
    }
1238

1239
  buf_size = 0;
1240
  err = gnutls_x509_crt_get_subject_unique_id (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1241
  check_memory_full (err);
1242 1243
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1244
      char *buf = xmalloc (buf_size);
1245
      err = gnutls_x509_crt_get_subject_unique_id (cert, buf, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1246
      check_memory_full (err);
1247 1248 1249
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":subject-unique-id"),
				  make_string (buf, buf_size)));
1250
      xfree (buf);
1251
    }
1252

1253
  /* Signature. */
1254
  err = gnutls_x509_crt_get_signature_algorithm (cert);
Paul Eggert's avatar
Paul Eggert committed
1255
  check_memory_full (err);
1256 1257
  if (err >= GNUTLS_E_SUCCESS)
    {
1258
      const char *name = gnutls_sign_get_name (err);
1259 1260 1261 1262 1263
      if (name)
	res = nconc2 (res, list2 (intern (":signature-algorithm"),
				  build_string (name)));
    }

1264
  /* Public key ID. */
1265
  buf_size = 0;
1266
  err = gnutls_x509_crt_get_key_id (cert, 0, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1267
  check_memory_full (err);
1268 1269
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1270
      void *buf = xmalloc (buf_size);
1271
      err = gnutls_x509_crt_get_key_id (cert, 0, buf, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1272
      check_memory_full (err);
1273 1274
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":public-key-id"),
1275 1276
				  gnutls_hex_string (buf, buf_size, "sha1:")));
      xfree (buf);
1277
    }
1278 1279

  /* Certificate fingerprint. */
1280
  buf_size = 0;
1281 1282
  err = gnutls_x509_crt_get_fingerprint (cert, GNUTLS_DIG_SHA1,
					 NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1283
  check_memory_full (err);
1284 1285
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {