gnutls.c 95 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-2019 Free Software Foundation, Inc.
Ted Zlatanov's avatar
Ted Zlatanov committed
3 4 5 6 7

This file is part of GNU Emacs.

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

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

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

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

#include "lisp.h"
#include "process.h"
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
#if GNUTLS_VERSION_NUMBER >= 0x030014
31 32
# define HAVE_GNUTLS_X509_SYSTEM_TRUST
#endif
Ted Zlatanov's avatar
Ted Zlatanov committed
33

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

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

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

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

51 52 53 54
#if GNUTLS_VERSION_NUMBER < 0x030600
# define HAVE_GNUTLS_COMPRESSION_GET
#endif

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

61 62 63 64
#if GNUTLS_VERSION_NUMBER >= 0x030501
# define HAVE_GNUTLS_EXT_GET_NAME
#endif

65 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.  */
#if GNUTLS_VERSION_NUMBER >= 0x030501
# define HAVE_GNUTLS_AEAD
73 74
#endif

75 76 77 78
#ifdef HAVE_GNUTLS

# 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 (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;
    }

Paul Eggert's avatar
Paul Eggert committed
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
Paul Eggert's avatar
Paul Eggert committed
319
  LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust);
320
#  endif
Paul Eggert's avatar
Paul Eggert committed
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
Paul Eggert's avatar
Paul Eggert committed
332
  LOAD_DLL_FN (library, gnutls_global_set_audit_log_function);
333
#  endif
Paul Eggert's avatar
Paul Eggert committed
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);
Paul Eggert's avatar
Paul Eggert committed
348
  LOAD_DLL_FN (library, gnutls_x509_crt_deinit);
349
  LOAD_DLL_FN (library, gnutls_x509_crt_export);
Paul Eggert's avatar
Paul Eggert committed
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);
Eli Zaretskii's avatar
Eli Zaretskii committed
360
  LOAD_DLL_FN (library, gnutls_x509_crt_print);
Paul Eggert's avatar
Paul Eggert committed
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
Eli Zaretskii's avatar
Eli Zaretskii committed
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);
}
Paul Eggert's avatar
Paul Eggert committed
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;
Paul Eggert's avatar
Paul Eggert committed
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.  */
Paul Eggert's avatar
Paul Eggert committed
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.  */
Paul Eggert's avatar
Paul Eggert committed
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)
{
Paul Eggert's avatar
Paul Eggert committed
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)
{
Paul Eggert's avatar
Paul Eggert committed
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

Paul Eggert's avatar
Paul Eggert committed
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)
    {
Paul Eggert's avatar
Paul Eggert committed
883
      int alert = gnutls_alert_get (session);
884
      int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
Paul Eggert's avatar
Paul Eggert committed
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 897 898 899
/* convert an integer error to a Lisp_Object; it will be either a
   known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or
   simply the integer value of the error.  GNUTLS_E_SUCCESS is mapped
   to Qt.  */
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");
Paul Eggert's avatar
Paul Eggert committed
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");
Paul Eggert's avatar
Paul Eggert committed
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
    {
Paul Eggert's avatar
Paul Eggert committed
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");

Tom Tromey's avatar
Tom Tromey committed
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");

Tom Tromey's avatar
Tom Tromey committed
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)