gnutls.c 94.5 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

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_rnd);
384
  LOAD_DLL_FN (library, gnutls_mac_list);
385
#   ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
386
  LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
387
#   endif
388
  LOAD_DLL_FN (library, gnutls_mac_get_key_size);
389
#   ifdef HAVE_GNUTLS_DIGEST_LIST
390 391
  LOAD_DLL_FN (library, gnutls_digest_list);
  LOAD_DLL_FN (library, gnutls_digest_get_name);
392
#   endif
393
  LOAD_DLL_FN (library, gnutls_cipher_list);
394
#   ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE
395
  LOAD_DLL_FN (library, gnutls_cipher_get_iv_size);
396
#   endif
397 398
  LOAD_DLL_FN (library, gnutls_cipher_get_key_size);
  LOAD_DLL_FN (library, gnutls_cipher_get_block_size);
399
#   ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE
400
  LOAD_DLL_FN (library, gnutls_cipher_get_tag_size);
401
#   endif
402 403 404 405
  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);
406
  LOAD_DLL_FN (library, gnutls_cipher_decrypt2);
407
#   ifdef HAVE_GNUTLS_AEAD
408 409 410 411
  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);
412 413 414
#   endif
#   ifdef HAVE_GNUTLS_ETM_STATUS
  LOAD_DLL_FN (library, gnutls_session_etm_status);
415
#   endif
416 417 418 419 420 421 422 423 424 425
  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);
426 427 428
#   ifdef HAVE_GNUTLS_EXT_GET_NAME
  LOAD_DLL_FN (library, gnutls_ext_get_name);
#   endif
429
#  endif	 /* HAVE_GNUTLS3 */
430

431
  max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
432
  {
433
    Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from));
434 435 436 437
    GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:",
                 STRINGP (name) ? (const char *) SDATA (name) : "unknown");
  }

438 439 440
  return 1;
}

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

562

563 564 565 566 567 568 569
/* 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
570

571
# endif	/* WINDOWSNT */
572 573

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

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

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

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

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

618 619 620 621
  if (proc->gnutls_complete_negotiation_p)
    non_blocking = false;

  if (non_blocking)
622 623
    proc->gnutls_p = true;

624
  while ((ret = gnutls_handshake (state)) < 0)
625
    {
626 627 628 629 630 631 632
      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
633
      maybe_quit ();
634 635 636 637 638 639 640 641 642 643 644
    }

  proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;

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

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

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

    default:
      return err;
    }
}
673
# endif	/* !WINDOWSNT */
674

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

  if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
681
    return -1;
682 683

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

706 707
      proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
    }
708

709
  return gnutls_try_handshake (proc);
710 711
}

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

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

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

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

737
  ptrdiff_t bytes_written = 0;
Ted Zlatanov's avatar
Ted Zlatanov committed
738 739 740

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

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

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

  return (bytes_written);
}

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

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

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

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

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

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

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

803 804
  check_memory_full (err);

805 806
  int max_log_level
    = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX);
807 808 809

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

810
  char const *str = emacs_gnutls_strerror (err);
811
  int errnum = EINVAL;
812

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

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

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

      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
	}
865 866 867 868 869
    }

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

      GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str);
    }
878 879

  errno = errnum;
880 881 882
  return ret;
}

Ted Zlatanov's avatar
Ted Zlatanov committed
883 884 885 886
/* 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.  */
887
static Lisp_Object
888
gnutls_make_error (int err)
Ted Zlatanov's avatar
Ted Zlatanov committed
889
{
890
  switch (err)
891 892 893 894 895 896 897 898 899 900
    {
    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
901

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

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

919 920 921 922 923 924 925
Lisp_Object
emacs_gnutls_deinit (Lisp_Object proc)
{
  int log_level;

  CHECK_PROCESS (proc);

926
  if (! XPROCESS (proc)->gnutls_p)
927 928 929 930 931 932 933
    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
934
      gnutls_certificate_free_credentials (XPROCESS (proc)->gnutls_x509_cred);
935 936 937 938 939 940
      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
941
      gnutls_anon_free_client_credentials (XPROCESS (proc)->gnutls_anon_cred);
942 943 944
      XPROCESS (proc)->gnutls_anon_cred = NULL;
    }

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

953 954 955
  if (XPROCESS (proc)->gnutls_certificates)
    gnutls_deinit_certificates (XPROCESS (proc));

956
  XPROCESS (proc)->gnutls_p = false;
957 958 959
  return Qt;
}

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

969
  XPROCESS (proc)->gnutls_boot_parameters = params;
970 971 972
  return Qnil;
}

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

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

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

  return Qt;
}

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

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

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

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

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

  return Qt;
}

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

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

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

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

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

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

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

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

  return ret;
}

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

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

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

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

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

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

  /* Validity. */
  {
1162 1163 1164
    /* Add 1 to the buffer size, since 1900 is added to tm_year and
       that might add 1 to the year length.  */
    char buf[INT_STRLEN_BOUND (int) + 1 + sizeof "-12-31"];