diff options
Diffstat (limited to 'src/gnutls.c')
| -rw-r--r-- | src/gnutls.c | 401 |
1 files changed, 235 insertions, 166 deletions
diff --git a/src/gnutls.c b/src/gnutls.c index 3c16b6c9c31..1afbb2bd4e5 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -25,36 +25,23 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "gnutls.h" #include "coding.h" #include "buffer.h" +#include "pdumper.h" #if GNUTLS_VERSION_NUMBER >= 0x030014 # define HAVE_GNUTLS_X509_SYSTEM_TRUST #endif -/* 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 -#elif GNUTLS_VERSION_NUMBER < 0x030202 -/* gnutls_cipher_get_tag_size was introduced in 3.2.2, but it's only - relevant for AEAD ciphers. */ -# define gnutls_cipher_get_tag_size(cipher) 0 +#if GNUTLS_VERSION_NUMBER >= 0x030200 +# define HAVE_GNUTLS_CIPHER_GET_IV_SIZE #endif -#if GNUTLS_VERSION_NUMBER < 0x030200 -/* gnutls_cipher_get_iv_size was introduced in 3.2.0. For the ciphers - available in previous versions, block size is equivalent. */ -#define gnutls_cipher_get_iv_size(cipher) gnutls_cipher_get_block_size (cipher) +#if GNUTLS_VERSION_NUMBER >= 0x030202 +# define HAVE_GNUTLS_CIPHER_GET_TAG_SIZE +# define HAVE_GNUTLS_DIGEST_LIST /* also gnutls_digest_get_name */ #endif -#if GNUTLS_VERSION_NUMBER < 0x030202 -/* gnutls_digest_list and gnutls_digest_get_name were added in 3.2.2. - For previous versions, the mac algorithms are equivalent. */ -# define gnutls_digest_list() ((const gnutls_digest_algorithm_t *) gnutls_mac_list ()) -# define gnutls_digest_get_name(id) gnutls_mac_get_name ((gnutls_mac_algorithm_t) id) +#if GNUTLS_VERSION_NUMBER >= 0x030205 +# define HAVE_GNUTLS_EXT__DUMBFW #endif /* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was @@ -67,18 +54,25 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ # define HAVE_GNUTLS_EXT_GET_NAME #endif -#if GNUTLS_VERSION_NUMBER >= 0x030205 -# define HAVE_GNUTLS_EXT__DUMBFW +/* 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 #endif #ifdef HAVE_GNUTLS # ifdef WINDOWSNT # include <windows.h> +# include "w32common.h" # include "w32.h" # endif -static bool emacs_gnutls_handle_error (gnutls_session_t, int); +static int emacs_gnutls_handle_error (gnutls_session_t, int); static bool gnutls_global_initialized; @@ -222,19 +216,17 @@ DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); # endif DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); -# ifndef gnutls_digest_list +# ifdef HAVE_GNUTLS_DIGEST_LIST DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); -# endif -# ifndef gnutls_digest_get_name DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); # endif DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void)); -# ifndef gnutls_cipher_get_iv_size +# ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t)); # endif 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)); -# ifndef gnutls_cipher_get_tag_size +# ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t)); # endif DEF_DLL_FN (int, gnutls_cipher_init, @@ -364,19 +356,17 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); # endif LOAD_DLL_FN (library, gnutls_mac_get_key_size); -# ifndef gnutls_digest_list +# ifdef HAVE_GNUTLS_DIGEST_LIST LOAD_DLL_FN (library, gnutls_digest_list); -# endif -# ifndef gnutls_digest_get_name LOAD_DLL_FN (library, gnutls_digest_get_name); # endif LOAD_DLL_FN (library, gnutls_cipher_list); -# ifndef gnutls_cipher_get_iv_size +# ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE LOAD_DLL_FN (library, gnutls_cipher_get_iv_size); # endif LOAD_DLL_FN (library, gnutls_cipher_get_key_size); LOAD_DLL_FN (library, gnutls_cipher_get_block_size); -# ifndef gnutls_cipher_get_tag_size +# ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE LOAD_DLL_FN (library, gnutls_cipher_get_tag_size); # endif LOAD_DLL_FN (library, gnutls_cipher_init); @@ -405,8 +395,7 @@ init_gnutls_functions (void) # endif # endif /* HAVE_GNUTLS3 */ - max_log_level = global_gnutls_log_level; - + max_log_level = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX); { Lisp_Object name = CAR_SAFE (Fget (Qgnutls, QCloaded_from)); GNUTLS_LOG2 (1, max_log_level, "GnuTLS library loaded:", @@ -488,19 +477,17 @@ init_gnutls_functions (void) # define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size # endif # define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size -# ifndef gnutls_digest_list +# ifdef HAVE_GNUTLS_DIGEST_LIST # define gnutls_digest_list fn_gnutls_digest_list -# endif -# ifndef gnutls_digest_get_name # define gnutls_digest_get_name fn_gnutls_digest_get_name # endif # define gnutls_cipher_list fn_gnutls_cipher_list -# ifndef gnutls_cipher_get_iv_size +# ifdef HAVE_GNUTLS_CIPHER_GET_IV_SIZE # define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size # endif # define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size # define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size -# ifndef gnutls_cipher_get_tag_size +# ifdef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE # define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size # endif # define gnutls_cipher_init fn_gnutls_cipher_init @@ -591,15 +578,17 @@ gnutls_try_handshake (struct Lisp_Process *proc) if (non_blocking) proc->gnutls_p = true; - do + while ((ret = gnutls_handshake (state)) < 0) { - ret = gnutls_handshake (state); - emacs_gnutls_handle_error (state, ret); + do + ret = gnutls_handshake (state); + while (ret == GNUTLS_E_INTERRUPTED); + + if (0 <= ret || emacs_gnutls_handle_error (state, ret) == 0 + || non_blocking) + break; maybe_quit (); } - while (ret < 0 - && gnutls_error_is_fatal (ret) == 0 - && ! non_blocking); proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED; @@ -694,8 +683,6 @@ emacs_gnutls_transport_set_errno (gnutls_session_t state, int err) ptrdiff_t emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte) { - ssize_t rtnval = 0; - ptrdiff_t bytes_written; gnutls_session_t state = proc->gnutls_state; if (proc->gnutls_initstage != GNUTLS_STAGE_READY) @@ -704,25 +691,19 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte) return 0; } - bytes_written = 0; + ptrdiff_t bytes_written = 0; while (nbyte > 0) { - rtnval = gnutls_record_send (state, buf, nbyte); + ssize_t rtnval; + do + rtnval = gnutls_record_send (state, buf, nbyte); + while (rtnval == GNUTLS_E_INTERRUPTED); if (rtnval < 0) { - if (rtnval == GNUTLS_E_INTERRUPTED) - continue; - else - { - /* If we get GNUTLS_E_AGAIN, then set errno - appropriately so that send_process retries the - correct way instead of erroring out. */ - if (rtnval == GNUTLS_E_AGAIN) - errno = EAGAIN; - break; - } + emacs_gnutls_handle_error (state, rtnval); + break; } buf += rtnval; @@ -730,14 +711,12 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte) bytes_written += rtnval; } - emacs_gnutls_handle_error (state, rtnval); return (bytes_written); } ptrdiff_t emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte) { - ssize_t rtnval; gnutls_session_t state = proc->gnutls_state; if (proc->gnutls_initstage != GNUTLS_STAGE_READY) @@ -746,19 +725,18 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte) return -1; } - rtnval = gnutls_record_recv (state, buf, nbyte); + ssize_t rtnval; + do + rtnval = gnutls_record_recv (state, buf, nbyte); + while (rtnval == GNUTLS_E_INTERRUPTED); + if (rtnval >= 0) return rtnval; else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH) /* The peer closed the connection. */ return 0; - else if (emacs_gnutls_handle_error (state, rtnval)) - /* non-fatal error */ - return -1; - else { - /* a fatal error occurred */ - return 0; - } + else + return emacs_gnutls_handle_error (state, rtnval); } static char const * @@ -769,25 +747,25 @@ emacs_gnutls_strerror (int err) } /* Report a GnuTLS error to the user. - Return true if the error code was successfully handled. */ -static bool + 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 emacs_gnutls_handle_error (gnutls_session_t session, int err) { - int max_log_level = 0; - - bool ret; + int ret; /* TODO: use a Lisp_Object generated by gnutls_make_error? */ - if (err >= 0) - return 1; check_memory_full (err); - max_log_level = global_gnutls_log_level; + int max_log_level + = clip_to_bounds (INT_MIN, global_gnutls_log_level, INT_MAX); /* TODO: use gnutls-error-fatalp and gnutls-error-string. */ char const *str = emacs_gnutls_strerror (err); + int errnum = EINVAL; if (gnutls_error_is_fatal (err)) { @@ -801,11 +779,11 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) # endif GNUTLS_LOG2 (level, max_log_level, "fatal error:", str); - ret = false; + ret = 0; } else { - ret = true; + ret = -1; switch (err) { @@ -821,6 +799,26 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) "non-fatal error:", str); } + + 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 + } } if (err == GNUTLS_E_WARNING_ALERT_RECEIVED @@ -834,6 +832,8 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str); } + + errno = errnum; return ret; } @@ -857,7 +857,20 @@ gnutls_make_error (int err) } check_memory_full (err); - return make_number (err); + return make_fixnum (err); +} + +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; } Lisp_Object @@ -894,6 +907,9 @@ emacs_gnutls_deinit (Lisp_Object proc) GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1; } + if (XPROCESS (proc)->gnutls_certificates) + gnutls_deinit_certificates (XPROCESS (proc)); + XPROCESS (proc)->gnutls_p = false; return Qt; } @@ -918,7 +934,7 @@ See also `gnutls-boot'. */) { CHECK_PROCESS (proc); - return make_number (GNUTLS_INITSTAGE (proc)); + return make_fixnum (GNUTLS_INITSTAGE (proc)); } DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0, @@ -958,10 +974,10 @@ Usage: (gnutls-error-fatalp ERROR) */) } } - if (! TYPE_RANGED_INTEGERP (int, err)) + if (! TYPE_RANGED_FIXNUMP (int, err)) error ("Not an error symbol or code"); - if (0 == gnutls_error_is_fatal (XINT (err))) + if (0 == gnutls_error_is_fatal (XFIXNUM (err))) return Qnil; return Qt; @@ -990,10 +1006,10 @@ usage: (gnutls-error-string ERROR) */) } } - if (! TYPE_RANGED_INTEGERP (int, err)) + if (! TYPE_RANGED_FIXNUMP (int, err)) return build_string ("Not an error symbol or code"); - return build_string (emacs_gnutls_strerror (XINT (err))); + return build_string (emacs_gnutls_strerror (XFIXNUM (err))); } DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, @@ -1037,7 +1053,7 @@ gnutls_certificate_details (gnutls_x509_crt_t cert) check_memory_full (version); if (version >= GNUTLS_E_SUCCESS) res = nconc2 (res, list2 (intern (":version"), - make_number (version))); + make_fixnum (version))); } /* Serial. */ @@ -1235,9 +1251,17 @@ DEFUN ("gnutls-peer-status-warning-describe", Fgnutls_peer_status_warning_descri DEFUN ("gnutls-peer-status", Fgnutls_peer_status, Sgnutls_peer_status, 1, 1, 0, doc: /* Describe a GnuTLS PROC peer certificate and any warnings about it. + The return value is a property list with top-level keys :warnings and -:certificate. The :warnings entry is a list of symbols you can describe with -`gnutls-peer-status-warning-describe'. */) +:certificates. + +The :warnings entry is a list of symbols you can get a description of +with `gnutls-peer-status-warning-describe', and :certificates is the +certificate chain for the connection, with the host certificate +first, and intermediary certificates (if any) following it. + +In addition, for backwards compatibility, the host certificate is also +returned as the :certificate entry. */) (Lisp_Object proc) { Lisp_Object warnings = Qnil, result = Qnil; @@ -1279,9 +1303,9 @@ The return value is a property list with top-level keys :warnings and /* This could get called in the INIT stage, when the certificate is not yet set. */ - if (XPROCESS (proc)->gnutls_certificate != NULL && - gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificate, - XPROCESS (proc)->gnutls_certificate)) + if (XPROCESS (proc)->gnutls_certificates != NULL && + gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificates[0], + XPROCESS (proc)->gnutls_certificates[0])) warnings = Fcons (intern (":self-signed"), warnings); if (!NILP (warnings)) @@ -1289,10 +1313,21 @@ The return value is a property list with top-level keys :warnings and /* This could get called in the INIT stage, when the certificate is not yet set. */ - if (XPROCESS (proc)->gnutls_certificate != NULL) - result = nconc2 (result, list2 - (intern (":certificate"), - gnutls_certificate_details (XPROCESS (proc)->gnutls_certificate))); + if (XPROCESS (proc)->gnutls_certificates != NULL) + { + Lisp_Object certs = Qnil; + + /* Return all the certificates in a list. */ + for (int i = 0; i < XPROCESS (proc)->gnutls_certificates_length; i++) + certs = nconc2 (certs, list1 (gnutls_certificate_details + (XPROCESS (proc)->gnutls_certificates[i]))); + + result = nconc2 (result, list2 (intern (":certificates"), certs)); + + /* Return the host certificate in its own element for + compatibility reasons. */ + result = nconc2 (result, list2 (intern (":certificate"), Fcar (certs))); + } state = XPROCESS (proc)->gnutls_state; @@ -1302,7 +1337,7 @@ The return value is a property list with top-level keys :warnings and check_memory_full (bits); if (bits > 0) result = nconc2 (result, list2 (intern (":diffie-hellman-prime-bits"), - make_number (bits))); + make_fixnum (bits))); } /* Key exchange. */ @@ -1435,7 +1470,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) if (ret < GNUTLS_E_SUCCESS) return gnutls_make_error (ret); - XPROCESS (proc)->gnutls_peer_verification = peer_verification; + p->gnutls_peer_verification = peer_verification; warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings")); if (!NILP (warnings)) @@ -1472,49 +1507,60 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) can be easily extended to work with openpgp keys as well. */ if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509) { - gnutls_x509_crt_t gnutls_verify_cert; - const gnutls_datum_t *gnutls_verify_cert_list; - unsigned int gnutls_verify_cert_list_size; + const gnutls_datum_t *cert_list; + unsigned int cert_list_length; + int failed_import = 0; - ret = gnutls_x509_crt_init (&gnutls_verify_cert); - if (ret < GNUTLS_E_SUCCESS) - return gnutls_make_error (ret); - - gnutls_verify_cert_list - = gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size); + cert_list = gnutls_certificate_get_peers (state, &cert_list_length); - if (gnutls_verify_cert_list == NULL) + if (cert_list == NULL) { - gnutls_x509_crt_deinit (gnutls_verify_cert); emacs_gnutls_deinit (proc); boot_error (p, "No x509 certificate was found\n"); return Qnil; } - /* Check only the first certificate in the given chain. */ - ret = gnutls_x509_crt_import (gnutls_verify_cert, - &gnutls_verify_cert_list[0], - GNUTLS_X509_FMT_DER); + /* Check only the first certificate in the given chain, but + store them all. */ + p->gnutls_certificates = + xmalloc (cert_list_length * sizeof (gnutls_x509_crt_t)); + p->gnutls_certificates_length = cert_list_length; - if (ret < GNUTLS_E_SUCCESS) + for (int i = cert_list_length - 1; i >= 0; i--) { - gnutls_x509_crt_deinit (gnutls_verify_cert); - return gnutls_make_error (ret); + gnutls_x509_crt_t cert; + + gnutls_x509_crt_init (&cert); + + if (ret < GNUTLS_E_SUCCESS) + failed_import = ret; + else + { + ret = gnutls_x509_crt_import (cert, &cert_list[i], + GNUTLS_X509_FMT_DER); + + if (ret < GNUTLS_E_SUCCESS) + failed_import = ret; + } + + p->gnutls_certificates[i] = cert; } - XPROCESS (proc)->gnutls_certificate = gnutls_verify_cert; + if (failed_import != 0) + { + gnutls_deinit_certificates (p); + return gnutls_make_error (failed_import); + } - int err = gnutls_x509_crt_check_hostname (gnutls_verify_cert, + int err = gnutls_x509_crt_check_hostname (p->gnutls_certificates[0], c_hostname); check_memory_full (err); if (!err) { - XPROCESS (proc)->gnutls_extra_peer_verification - |= CERTIFICATE_NOT_MATCHING; + p->gnutls_extra_peer_verification |= CERTIFICATE_NOT_MATCHING; if (verify_error_all || !NILP (Fmember (QChostname, verify_error))) { - gnutls_x509_crt_deinit (gnutls_verify_cert); emacs_gnutls_deinit (proc); boot_error (p, "The x509 certificate does not match \"%s\"", c_hostname); @@ -1527,7 +1573,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) } /* Set this flag only if the whole initialization succeeded. */ - XPROCESS (proc)->gnutls_p = true; + p->gnutls_p = true; return gnutls_make_error (ret); } @@ -1645,14 +1691,17 @@ one trustfile (usually a CA bundle). */) state = XPROCESS (proc)->gnutls_state; - if (TYPE_RANGED_INTEGERP (int, loglevel)) + if (INTEGERP (loglevel)) { gnutls_global_set_log_function (gnutls_log_function); # ifdef HAVE_GNUTLS3 gnutls_global_set_audit_log_function (gnutls_audit_log_function); # endif - gnutls_global_set_log_level (XINT (loglevel)); - max_log_level = XINT (loglevel); + int level = (FIXNUMP (loglevel) + ? clip_to_bounds (INT_MIN, XFIXNUM (loglevel), INT_MAX) + : NILP (Fnatnump (loglevel)) ? INT_MIN : INT_MAX); + gnutls_global_set_log_level (level); + max_log_level = level; XPROCESS (proc)->gnutls_log_level = max_log_level; } @@ -1685,9 +1734,9 @@ one trustfile (usually a CA bundle). */) XPROCESS (proc)->gnutls_x509_cred = x509_cred; verify_flags = Fplist_get (proplist, QCverify_flags); - if (TYPE_RANGED_INTEGERP (unsigned int, verify_flags)) + if (TYPE_RANGED_FIXNUMP (unsigned int, verify_flags)) { - gnutls_verify_flags = XFASTINT (verify_flags); + gnutls_verify_flags = XFIXNAT (verify_flags); GNUTLS_LOG (2, max_log_level, "setting verification flags"); } else if (NILP (verify_flags)) @@ -1846,8 +1895,8 @@ one trustfile (usually a CA bundle). */) GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY; - if (INTEGERP (prime_bits)) - gnutls_dh_set_prime_bits (state, XUINT (prime_bits)); + if (FIXNUMP (prime_bits)) + gnutls_dh_set_prime_bits (state, XUFIXNUM (prime_bits)); ret = EQ (type, Qgnutls_x509pki) ? gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred) @@ -1896,7 +1945,8 @@ This function may also return `gnutls-e-again', or state = XPROCESS (proc)->gnutls_state; - gnutls_x509_crt_deinit (XPROCESS (proc)->gnutls_certificate); + if (XPROCESS (proc)->gnutls_certificates) + gnutls_deinit_certificates (XPROCESS (proc)); ret = gnutls_bye (state, NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR); @@ -1907,6 +1957,24 @@ This function may also return `gnutls-e-again', or #ifdef HAVE_GNUTLS3 +# ifndef HAVE_GNUTLS_CIPHER_GET_IV_SIZE + /* Block size is equivalent. */ +# define gnutls_cipher_get_iv_size(cipher) gnutls_cipher_get_block_size (cipher) +# endif + +# ifndef HAVE_GNUTLS_CIPHER_GET_TAG_SIZE + /* Tag size is irrelevant. */ +# define gnutls_cipher_get_tag_size(cipher) 0 +# endif + +# ifndef HAVE_GNUTLS_DIGEST_LIST + /* The mac algorithms are equivalent. */ +# define gnutls_digest_list() \ + ((gnutls_digest_algorithm_t const *) gnutls_mac_list ()) +# define gnutls_digest_get_name(id) \ + gnutls_mac_get_name ((gnutls_mac_algorithm_t) (id)) +# endif + DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0, doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists. The alist key is the cipher name. */) @@ -1930,20 +1998,20 @@ The alist key is the cipher name. */) ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); Lisp_Object cp - = listn (CONSTYPE_HEAP, 15, cipher_symbol, - QCcipher_id, make_number (gca), + = list (cipher_symbol, + QCcipher_id, make_fixnum (gca), QCtype, Qgnutls_type_cipher, QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt, - QCcipher_tagsize, make_number (cipher_tag_size), + QCcipher_tagsize, make_fixnum (cipher_tag_size), QCcipher_blocksize, - make_number (gnutls_cipher_get_block_size (gca)), + make_fixnum (gnutls_cipher_get_block_size (gca)), QCcipher_keysize, - make_number (gnutls_cipher_get_key_size (gca)), + make_fixnum (gnutls_cipher_get_key_size (gca)), QCcipher_ivsize, - make_number (gnutls_cipher_get_iv_size (gca))); + make_fixnum (gnutls_cipher_get_iv_size (gca))); ciphers = Fcons (cp, ciphers); } @@ -2073,16 +2141,16 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, cipher); info = XCDR (info); } - else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher)) - gca = XINT (cipher); + else if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, cipher)) + gca = XFIXNUM (cipher); else info = cipher; if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCcipher_id); - if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, v)) - gca = XINT (v); + if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, v)) + gca = XFIXNUM (v); } ptrdiff_t key_size = gnutls_cipher_get_key_size (gca); @@ -2258,21 +2326,21 @@ name. */) Lisp_Object gma_symbol = intern (gnutls_mac_get_name (gma)); size_t nonce_size = 0; -#ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE +# ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE nonce_size = gnutls_mac_get_nonce_size (gma); -#endif - Lisp_Object mp = listn (CONSTYPE_HEAP, 11, gma_symbol, - QCmac_algorithm_id, make_number (gma), +# endif + Lisp_Object mp = list (gma_symbol, + QCmac_algorithm_id, make_fixnum (gma), QCtype, Qgnutls_type_mac_algorithm, QCmac_algorithm_length, - make_number (gnutls_hmac_get_len (gma)), + make_fixnum (gnutls_hmac_get_len (gma)), QCmac_algorithm_keysize, - make_number (gnutls_mac_get_key_size (gma)), + make_fixnum (gnutls_mac_get_key_size (gma)), QCmac_algorithm_noncesize, - make_number (nonce_size)); + make_fixnum (nonce_size)); mac_algorithms = Fcons (mp, mac_algorithms); } @@ -2296,12 +2364,12 @@ method name. */) /* A symbol representing the GnuTLS digest algorithm. */ Lisp_Object gda_symbol = intern (gnutls_digest_get_name (gda)); - Lisp_Object mp = listn (CONSTYPE_HEAP, 7, gda_symbol, - QCdigest_algorithm_id, make_number (gda), + Lisp_Object mp = list (gda_symbol, + QCdigest_algorithm_id, make_fixnum (gda), QCtype, Qgnutls_type_digest_algorithm, QCdigest_algorithm_length, - make_number (gnutls_hash_get_len (gda))); + make_fixnum (gnutls_hash_get_len (gda))); digest_algorithms = Fcons (mp, digest_algorithms); } @@ -2352,16 +2420,16 @@ itself. */) hash_method); info = XCDR (info); } - else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method)) - gma = XINT (hash_method); + else if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, hash_method)) + gma = XFIXNUM (hash_method); else info = hash_method; if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); - if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, v)) - gma = XINT (v); + if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, v)) + gma = XFIXNUM (v); } ptrdiff_t digest_length = gnutls_hmac_get_len (gma); @@ -2442,16 +2510,16 @@ the number itself. */) digest_method); info = XCDR (info); } - else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method)) - gda = XINT (digest_method); + else if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, digest_method)) + gda = XFIXNUM (digest_method); else info = digest_method; if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); - if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, v)) - gda = XINT (v); + if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, v)) + gda = XFIXNUM (v); } ptrdiff_t digest_length = gnutls_hash_get_len (gda); @@ -2565,15 +2633,16 @@ syms_of_gnutls (void) DEFSYM (Qlibgnutls_version, "libgnutls-version"); Fset (Qlibgnutls_version, #ifdef HAVE_GNUTLS - make_number (GNUTLS_VERSION_MAJOR * 10000 + make_fixnum (GNUTLS_VERSION_MAJOR * 10000 + GNUTLS_VERSION_MINOR * 100 + GNUTLS_VERSION_PATCH) #else - make_number (-1) + make_fixnum (-1) #endif ); #ifdef HAVE_GNUTLS gnutls_global_initialized = 0; + PDUMPER_IGNORE (gnutls_global_initialized); DEFSYM (Qgnutls_code, "gnutls-code"); DEFSYM (Qgnutls_anon, "gnutls-anon"); @@ -2613,19 +2682,19 @@ syms_of_gnutls (void) DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted"); Fput (Qgnutls_e_interrupted, Qgnutls_code, - make_number (GNUTLS_E_INTERRUPTED)); + make_fixnum (GNUTLS_E_INTERRUPTED)); DEFSYM (Qgnutls_e_again, "gnutls-e-again"); Fput (Qgnutls_e_again, Qgnutls_code, - make_number (GNUTLS_E_AGAIN)); + make_fixnum (GNUTLS_E_AGAIN)); DEFSYM (Qgnutls_e_invalid_session, "gnutls-e-invalid-session"); Fput (Qgnutls_e_invalid_session, Qgnutls_code, - make_number (GNUTLS_E_INVALID_SESSION)); + make_fixnum (GNUTLS_E_INVALID_SESSION)); DEFSYM (Qgnutls_e_not_ready_for_handshake, "gnutls-e-not-ready-for-handshake"); Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code, - make_number (GNUTLS_E_APPLICATION_ERROR_MIN)); + make_fixnum (GNUTLS_E_APPLICATION_ERROR_MIN)); defsubr (&Sgnutls_get_initstage); defsubr (&Sgnutls_asynchronous_parameters); |