gnutls.c 94.7 KB
Newer Older
Ted Zlatanov's avatar
Ted Zlatanov committed
1
/* GnuTLS glue for GNU Emacs.
Paul Eggert's avatar
Paul Eggert committed
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"
Paul Eggert's avatar
Paul Eggert committed
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

Paul Eggert's avatar
Paul Eggert committed
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
Paul Eggert's avatar
Paul Eggert committed
125 126
DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust,
	    (gnutls_certificate_credentials_t));
127
#  endif
Paul Eggert's avatar
Paul Eggert committed
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
Paul Eggert's avatar
Paul Eggert committed
145
DEF_DLL_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func));
146
#  endif
Paul Eggert's avatar
Paul Eggert committed
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));
Paul Eggert's avatar
Paul Eggert committed
169
DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
Eli Zaretskii's avatar
Eli Zaretskii committed
170
DEF_DLL_FN (int, gnutls_x509_crt_export,
171
            (gnutls_x509_crt_t, gnutls_x509_crt_fmt_t, void *, size_t *));
Paul Eggert's avatar
Paul Eggert committed
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,
Paul Eggert's avatar
Paul Eggert committed
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));
Paul Eggert's avatar
Paul Eggert committed
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));
Paul Eggert's avatar
Paul Eggert committed
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));
Paul Eggert's avatar
Paul Eggert committed
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,
Paul Eggert's avatar
Paul Eggert committed
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 (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
234
#   ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
235
DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
236
#   endif
237
DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t));
238
#   ifdef HAVE_GNUTLS_DIGEST_LIST
239 240
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));
241
#   endif
242
DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void));
243
#   ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
244
DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t));
245
#   endif
246 247
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));
248
#   ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
249
DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t));
250
#   endif
251 252 253
DEF_DLL_FN (int, gnutls_cipher_init,
	    (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t,
	     const gnutls_datum_t *, const gnutls_datum_t *));
254 255 256 257 258 259
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));
260
#   ifdef HAVE_GNUTLS_AEAD
261 262 263 264 265 266 267 268 269 270
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 *));
271
#   endif
272 273 274
#   ifdef HAVE_GNUTLS_ETM_STATUS
DEF_DLL_FN (unsigned, gnutls_session_etm_status, (gnutls_session_t));
#   endif
275 276 277 278 279 280
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 *));
281 282
  DEF_DLL_FN (int, gnutls_hash_init,
	    (gnutls_hash_hd_t *, gnutls_digest_algorithm_t));
283 284 285 286
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 *));
287 288 289
#   ifdef HAVE_GNUTLS_EXT_GET_NAME
DEF_DLL_FN (const char *, gnutls_ext_get_name, (unsigned int));
#   endif
290
#  endif	 /* HAVE_GNUTLS3 */
291

292
static gnutls_free_function *gnutls_free_func;
293

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

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

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

430 431 432 433 434 435 436
  /* 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;

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

444 445 446
  return 1;
}

447 448 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
#  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
479 480 481 482
#  ifdef HAVE_GNUTLS_COMPRESSION_GET
#   define gnutls_compression_get fn_gnutls_compression_get
#   define gnutls_compression_get_name fn_gnutls_compression_get_name
#  endif
Eli Zaretskii's avatar
Eli Zaretskii committed
483
#  define gnutls_safe_renegotiation_status fn_gnutls_safe_renegotiation_status
484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502
#  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
503
#  define gnutls_x509_crt_export fn_gnutls_x509_crt_export
504 505 506 507 508 509 510 511
#  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
512
#  define gnutls_x509_crt_print fn_gnutls_x509_crt_print
513 514 515 516 517 518 519 520
#  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_mac_list fn_gnutls_mac_list
521 522 523
#   ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
#    define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
#   endif
524
#  define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
525
#  ifdef HAVE_GNUTLS_DIGEST_LIST
526 527 528
#   define gnutls_digest_list fn_gnutls_digest_list
#   define gnutls_digest_get_name fn_gnutls_digest_get_name
#  endif
529
#  define gnutls_cipher_list fn_gnutls_cipher_list
530
#  ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
531 532
#   define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
#  endif
533 534
#  define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
#  define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
535
#  ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
536 537
#   define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
#  endif
538 539 540 541 542 543
#  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
544 545 546 547
#    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
548
#   endif
549 550 551
#   ifdef HAVE_GNUTLS_ETM_STATUS
#    define gnutls_session_etm_status fn_gnutls_session_etm_status
#   endif
552 553 554 555 556 557 558 559 560 561
#  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
562 563 564
#   ifdef HAVE_GNUTLS_EXT_GET_NAME
#    define gnutls_ext_get_name fn_gnutls_ext_get_name
#   endif
565
#  endif	 /* HAVE_GNUTLS3 */
566

567 568 569
/* 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.  */
570 571
#  undef gnutls_free
#  define gnutls_free (*gnutls_free_func)
572

573
# endif	/* WINDOWSNT */
574 575

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

587
# ifdef HAVE_GNUTLS3
588
/* Log a simple audit message.  */
589
static void
590
gnutls_audit_log_function (gnutls_session_t session, const char *string)
591 592 593 594 595 596
{
  if (global_gnutls_log_level >= 1)
    {
      message ("gnutls.c: [audit] %s", string);
    }
}
597
# endif
598

599
/* Log a simple message.  */
600
static void
601
gnutls_log_function (int level, const char *string)
602 603 604 605
{
  message ("gnutls.c: [%d] %s", level, string);
}

606
/* Log a message and a string.  */
607
static void
608
gnutls_log_function2 (int level, const char *string, const char *extra)
609 610 611 612
{
  message ("gnutls.c: [%d] %s %s", level, string, extra);
}

613 614 615 616 617
int
gnutls_try_handshake (struct Lisp_Process *proc)
{
  gnutls_session_t state = proc->gnutls_state;
  int ret;
618
  bool non_blocking = proc->is_non_blocking_client;
619

620 621 622 623
  if (proc->gnutls_complete_negotiation_p)
    non_blocking = false;

  if (non_blocking)
624 625
    proc->gnutls_p = true;

626
  while ((ret = gnutls_handshake (state)) < 0)
627
    {
628 629 630 631 632 633 634
      do
	ret = gnutls_handshake (state);
      while (ret == GNUTLS_E_INTERRUPTED);

      if (0 <= ret || emacs_gnutls_handle_error (state, ret) == 0
	  || non_blocking)
	break;
Paul Eggert's avatar
Paul Eggert committed
635
      maybe_quit ();
636 637 638 639 640 641 642 643 644 645 646
    }

  proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;

  if (ret == GNUTLS_E_SUCCESS)
    {
      /* Here we're finally done.  */
      proc->gnutls_initstage = GNUTLS_STAGE_READY;
    }
  else
    {
647
      /* check_memory_full (gnutls_alert_send_appropriate (state, ret));  */
648 649 650 651
    }
  return ret;
}

652
# ifndef WINDOWSNT
653 654 655 656 657 658 659
static int
emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
{
  int err = errno;

  switch (err)
    {
660
#  ifdef _AIX
661
      /* This is taken from the GnuTLS system_errno function circa 2016;
662
	 see <https://savannah.gnu.org/support/?107464>.  */
663 664 665
    case 0:
      errno = EAGAIN;
      /* Fall through.  */
666
#  endif
667 668 669 670 671 672 673 674
    case EINPROGRESS:
    case ENOTCONN:
      return EAGAIN;

    default:
      return err;
    }
}
675
# endif	/* !WINDOWSNT */
676

677
static int
678 679 680 681 682
emacs_gnutls_handshake (struct Lisp_Process *proc)
{
  gnutls_session_t state = proc->gnutls_state;

  if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
683
    return -1;
684 685

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

708 709
      proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
    }
710

711
  return gnutls_try_handshake (proc);
712 713
}

714
ptrdiff_t
715 716
emacs_gnutls_record_check_pending (gnutls_session_t state)
{
Paul Eggert's avatar
Paul Eggert committed
717
  return gnutls_record_check_pending (state);
718 719
}

720
# ifdef WINDOWSNT
721 722 723
void
emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
{
Paul Eggert's avatar
Paul Eggert committed
724
  gnutls_transport_set_errno (state, err);
725
}
726
# endif
727

728 729
ptrdiff_t
emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
Ted Zlatanov's avatar
Ted Zlatanov committed
730
{
731 732
  gnutls_session_t state = proc->gnutls_state;

733 734 735 736 737
  if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
    {
      errno = EAGAIN;
      return 0;
    }
Ted Zlatanov's avatar
Ted Zlatanov committed
738

739
  ptrdiff_t bytes_written = 0;
Ted Zlatanov's avatar
Ted Zlatanov committed
740 741 742

  while (nbyte > 0)
    {
743 744 745 746
      ssize_t rtnval;
      do
	rtnval = gnutls_record_send (state, buf, nbyte);
      while (rtnval == GNUTLS_E_INTERRUPTED);
Ted Zlatanov's avatar
Ted Zlatanov committed
747

748
      if (rtnval < 0)
Andreas Schwab's avatar
Andreas Schwab committed
749
	{
750 751
	  emacs_gnutls_handle_error (state, rtnval);
	  break;
Andreas Schwab's avatar
Andreas Schwab committed
752
	}
Ted Zlatanov's avatar
Ted Zlatanov committed
753 754 755 756 757 758 759 760 761

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

  return (bytes_written);
}

762 763
ptrdiff_t
emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
Ted Zlatanov's avatar
Ted Zlatanov committed
764
{
765 766
  gnutls_session_t state = proc->gnutls_state;

767
  if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
768 769 770 771
    {
      errno = EAGAIN;
      return -1;
    }
772

773 774 775 776 777
  ssize_t rtnval;
  do
    rtnval = gnutls_record_recv (state, buf, nbyte);
  while (rtnval == GNUTLS_E_INTERRUPTED);

778 779
  if (rtnval >= 0)
    return rtnval;
780 781 782
  else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
    /* The peer closed the connection. */
    return 0;
783 784
  else
    return emacs_gnutls_handle_error (state, rtnval);
Ted Zlatanov's avatar
Ted Zlatanov committed
785 786
}

787 788 789 790 791 792 793
static char const *
emacs_gnutls_strerror (int err)
{
  char const *str = gnutls_strerror (err);
  return str ? str : "unknown";
}

794
/* Report a GnuTLS error to the user.
795 796 797 798
   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
799 800
emacs_gnutls_handle_error (gnutls_session_t session, int err)
{
801
  int ret;
802 803 804

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

805 806
  check_memory_full (err);

807 808
  int max_log_level
    = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
809 810 811

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

812
  char const *str = emacs_gnutls_strerror (err);
813
  int errnum = EINVAL;
814

Paul Eggert's avatar
Paul Eggert committed
815
  if (gnutls_error_is_fatal (err))
816
    {
817 818 819 820
      int level = 1;
      /* Mostly ignore "The TLS connection was non-properly
	 terminated" message which just means that the peer closed the
	 connection.  */
821
# ifdef HAVE_GNUTLS3
822 823
      if (err == GNUTLS_E_PREMATURE_TERMINATION)
	level = 3;
824
# endif
825 826

      GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
827
      ret = 0;
828 829 830
    }
  else
    {
831
      ret = -1;
832 833 834 835 836 837 838 839

      switch (err)
        {
        case GNUTLS_E_AGAIN:
          GNUTLS_LOG2 (3,
                       max_log_level,
                       "retry:",
                       str);
840
	  FALLTHROUGH;
841 842 843 844 845 846
        default:
          GNUTLS_LOG2 (1,
                       max_log_level,
                       "non-fatal error:",
                       str);
        }
847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866

      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
	}
867 868 869 870 871
    }

  if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
      || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
    {
Paul Eggert's avatar
Paul Eggert committed
872
      int alert = gnutls_alert_get (session);
873
      int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
Paul Eggert's avatar
Paul Eggert committed
874
      str = gnutls_alert_get_name (alert);
875 876 877 878 879
      if (!str)
	str = "unknown";

      GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str);
    }
880 881

  errno = errnum;
882 883 884
  return ret;
}

Ted Zlatanov's avatar
Ted Zlatanov committed
885
/* convert an integer error to a Lisp_Object; it will be either a
886
   known symbol like 'gnutls_e_interrupted' and 'gnutls_e_again' or
Ted Zlatanov's avatar
Ted Zlatanov committed
887 888
   simply the integer value of the error.  GNUTLS_E_SUCCESS is mapped
   to Qt.  */
889
static Lisp_Object
890
gnutls_make_error (int err)
Ted Zlatanov's avatar
Ted Zlatanov committed
891
{
892
  switch (err)
893 894 895 896 897 898 899 900 901 902
    {
    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
903

904
  check_memory_full (err);
905
  return make_fixnum (err);
Ted Zlatanov's avatar
Ted Zlatanov committed
906 907
}

908 909 910 911 912 913 914 915 916 917 918 919 920
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;
}

921 922 923 924 925 926 927
Lisp_Object
emacs_gnutls_deinit (Lisp_Object proc)
{
  int log_level;

  CHECK_PROCESS (proc);

928
  if (! XPROCESS (proc)->gnutls_p)
929 930 931 932 933 934 935
    return Qnil;

  log_level = XPROCESS (proc)->gnutls_log_level;

  if (XPROCESS (proc)->gnutls_x509_cred)
    {
      GNUTLS_LOG (2, log_level, "Deallocating x509 credentials");
Paul Eggert's avatar
Paul Eggert committed
936
      gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
937 938 939 940 941 942
      XPROCESS (proc)->gnutls_x509_cred = NULL;
    }

  if (XPROCESS (proc)->gnutls_anon_cred)
    {
      GNUTLS_LOG (2, log_level, "Deallocating anon credentials");
Paul Eggert's avatar
Paul Eggert committed
943
      gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
944 945 946
      XPROCESS (proc)->gnutls_anon_cred = NULL;
    }

Chong Yidong's avatar
Chong Yidong committed
947
  if (XPROCESS (proc)->gnutls_state)
948
    {
Paul Eggert's avatar
Paul Eggert committed
949
      gnutls_deinit (XPROCESS (proc)->gnutls_state);
Chong Yidong's avatar
Chong Yidong committed
950 951 952
      XPROCESS (proc)->gnutls_state = NULL;
      if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
	GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
953 954
    }

955 956 957
  if (XPROCESS (proc)->gnutls_certificates)
    gnutls_deinit_certificates (XPROCESS (proc));

958
  XPROCESS (proc)->gnutls_p = false;
959 960 961
  return Qt;
}

962 963 964 965 966 967
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)
968 969 970
{
  CHECK_PROCESS (proc);

971
  XPROCESS (proc)->gnutls_boot_parameters = params;
972 973 974
  return Qnil;
}

Ted Zlatanov's avatar
Ted Zlatanov committed
975
DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
976
       doc: /* Return the GnuTLS init stage of process PROC.
Ted Zlatanov's avatar
Ted Zlatanov committed
977
See also `gnutls-boot'.  */)
978
  (Lisp_Object proc)
Ted Zlatanov's avatar
Ted Zlatanov committed
979 980 981
{
  CHECK_PROCESS (proc);

982
  return make_fixnum (GNUTLS_INITSTAGE (proc));
Ted Zlatanov's avatar
Ted Zlatanov committed
983 984 985
}

DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
986 987
       doc: /* Return t if ERROR indicates a GnuTLS problem.
ERROR is an integer or a symbol with an integer `gnutls-code' property.
988 989
usage: (gnutls-errorp ERROR)  */
       attributes: const)
990
  (Lisp_Object err)
Ted Zlatanov's avatar
Ted Zlatanov committed
991
{
992 993 994
  if (EQ (err, Qt)
      || EQ (err, Qgnutls_e_again))
    return Qnil;
Ted Zlatanov's avatar
Ted Zlatanov committed
995 996 997 998 999

  return Qt;
}

DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0,
1000
       doc: /* Return non-nil if ERROR is fatal.
1001
ERROR is an integer or a symbol with an integer `gnutls-code' property.
1002
Usage: (gnutls-error-fatalp ERROR)  */)
1003
  (Lisp_Object err)
Ted Zlatanov's avatar
Ted Zlatanov committed
1004 1005 1006 1007 1008 1009 1010
{
  Lisp_Object code;

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

  if (SYMBOLP (err))
    {
1011
      code = Fget (err, Qgnutls_code);
1012
      if (NUMBERP (code))
1013 1014 1015 1016 1017 1018 1019
	{
	  err = code;
	}
      else
	{
	  error ("Symbol has no numeric gnutls-code property");
	}
Ted Zlatanov's avatar
Ted Zlatanov committed
1020 1021
    }

1022
  if (! TYPE_RANGED_FIXNUMP (int, err))
Ted Zlatanov's avatar
Ted Zlatanov committed
1023 1024
    error ("Not an error symbol or code");

Tom Tromey's avatar
Tom Tromey committed
1025
  if (0 == gnutls_error_is_fatal (XFIXNUM (err)))
Ted Zlatanov's avatar
Ted Zlatanov committed
1026 1027 1028 1029 1030 1031
    return Qnil;

  return Qt;
}

DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0,
1032 1033 1034 1035
       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
1036 1037 1038 1039 1040 1041 1042
{
  Lisp_Object code;

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

  if (SYMBOLP (err))
    {
1043
      code = Fget (err, Qgnutls_code);
1044
      if (NUMBERP (code))
1045 1046 1047 1048 1049 1050 1051
	{
	  err = code;
	}
      else
	{
	  return build_string ("Symbol has no numeric gnutls-code property");
	}
Ted Zlatanov's avatar
Ted Zlatanov committed
1052 1053
    }

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

Tom Tromey's avatar
Tom Tromey committed
1057
  return build_string (emacs_gnutls_strerror (XFIXNUM (err)));
Ted Zlatanov's avatar
Ted Zlatanov committed
1058 1059 1060
}

DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
1061
       doc: /* Deallocate GnuTLS resources associated with process PROC.
Ted Zlatanov's avatar
Ted Zlatanov committed
1062
See also `gnutls-init'.  */)
1063
  (Lisp_Object proc)
Ted Zlatanov's avatar
Ted Zlatanov committed
1064
{
1065
  return emacs_gnutls_deinit (proc);
Ted Zlatanov's avatar
Ted Zlatanov committed
1066 1067
}

1068
static Lisp_Object
1069
gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
1070
{
1071
  ptrdiff_t prefix_length = strlen (prefix);
1072 1073 1074
  ptrdiff_t retlen;
  if (INT_MULTIPLY_WRAPV (buf_size, 3, &retlen)
      || INT_ADD_WRAPV (prefix_length - (buf_size != 0), retlen, &retlen))
1075
    string_overflow ();
1076
  Lisp_Object ret = make_uninit_string (retlen);
1077
  char *string = SSDATA (ret);
1078 1079
  strcpy (string, prefix);

1080
  for (ptrdiff_t i = 0; i < buf_size; i++)
1081
    sprintf (string + i * 3 + prefix_length,
1082
	     i == buf_size - 1 ? "%02x" : "%02x:",
1083
	     buf[i]);
1084 1085 1086 1087

  return ret;
}

1088
static Lisp_Object
1089 1090 1091 1092 1093 1094 1095 1096
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)
    {
1097 1098
      USE_SAFE_ALLOCA;
      char *buf = SAFE_ALLOCA (size);
1099 1100 1101 1102
      err = gnutls_x509_crt_export (cert, GNUTLS_X509_FMT_PEM, buf, &size);
      check_memory_full (err);

      if (err < GNUTLS_E_SUCCESS)
1103 1104
	error ("GnuTLS certificate export error: %s",
	       emacs_gnutls_strerror (err));
1105

1106 1107 1108
      Lisp_Object result = build_string (buf);
      SAFE_FREE ();
      return result;
1109 1110 1111 1112 1113 1114 1115 1116 1117
    }
  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)
1118 1119 1120
{
  Lisp_Object res = Qnil;
  int err;
1121
  size_t buf_size;
1122 1123 1124

  /* Version. */
  {
Paul Eggert's avatar
Paul Eggert committed
1125
    int version = gnutls_x509_crt_get_version (cert);
Paul Eggert's avatar
Paul Eggert committed
1126
    check_memory_full (version);
1127 1128
    if (version >= GNUTLS_E_SUCCESS)
      res = nconc2 (res, list2 (intern (":version"),
1129
				make_fixnum (version)));
1130 1131 1132
  }

  /* Serial. */
1133
  buf_size = 0;
Paul Eggert's avatar
Paul Eggert committed
1134
  err = gnutls_x509_crt_get_serial (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1135
  check_memory_full (err);
1136 1137
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1138
      void *serial = xmalloc (buf_size);
Paul Eggert's avatar
Paul Eggert committed
1139
      err = gnutls_x509_crt_get_serial (cert, serial, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1140
      check_memory_full (err);
1141 1142 1143
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":serial-number"),
				  gnutls_hex_string (serial, buf_size, "")));
1144
      xfree (serial);
1145
    }
1146 1147

  /* Issuer. */
1148
  buf_size = 0;
Paul Eggert's avatar
Paul Eggert committed
1149
  err = gnutls_x509_crt_get_issuer_dn (cert, NULL, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1150
  check_memory_full (err);
1151 1152
  if (err == GNUTLS_E_SHORT_MEMORY_BUFFER)
    {
1153
      char *dn = xmalloc (buf_size);
Paul Eggert's avatar
Paul Eggert committed
1154
      err = gnutls_x509_crt_get_issuer_dn (cert, dn, &buf_size);
Paul Eggert's avatar
Paul Eggert committed
1155
      check_memory_full (err);
1156 1157 1158
      if (err >= GNUTLS_E_SUCCESS)
	res = nconc2 (res, list2 (intern (":issuer"),
				  make_string (dn, buf_size)));