diff options
| -rw-r--r-- | configure.ac | 134 | ||||
| -rw-r--r-- | src/fns.c | 49 | ||||
| -rw-r--r-- | src/gnutls.c | 489 | ||||
| -rw-r--r-- | src/lisp.h | 4 |
4 files changed, 317 insertions, 359 deletions
diff --git a/configure.ac b/configure.ac index 525aa51598a..056c8c35c57 100644 --- a/configure.ac +++ b/configure.ac @@ -2832,60 +2832,86 @@ if test "${with_gnutls}" = "yes" ; then EMACS_CHECK_MODULES([LIBGNUTLS3], [gnutls >= 3.0.0], [AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.])], []) - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#include <gnutls/gnutls.h> -#include <gnutls/crypto.h> -]], -[[ -int main (int argc, char **argv) -{ - gnutls_hmac_hd_t handle; - gnutls_hmac_deinit(handle, NULL); -} -]])], - [AC_DEFINE(HAVE_GNUTLS3_HMAC, 1, [Define if using GnuTLS v3 with HMAC support.])]) - - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#include <gnutls/gnutls.h> -#include <gnutls/crypto.h> -]], -[[ -int main (int argc, char **argv) -{ - gnutls_aead_cipher_hd_t handle; - gnutls_aead_cipher_deinit(handle); -} -]])], - [AC_DEFINE(HAVE_GNUTLS3_AEAD, 1, [Define if using GnuTLS v3 with AEAD support.])]) - - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#include <gnutls/gnutls.h> -#include <gnutls/crypto.h> -]], -[[ -int main (int argc, char **argv) -{ - gnutls_cipher_hd_t handle; - gnutls_cipher_encrypt2 (handle, - NULL, 0, - NULL, 0); - gnutls_cipher_deinit(handle); -} -]])], - [AC_DEFINE(HAVE_GNUTLS3_CIPHER, 1, [Define if using GnuTLS v3 with cipher support.])]) - - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#include <gnutls/gnutls.h> -#include <gnutls/crypto.h> -]], -[[ -int main (int argc, char **argv) -{ - gnutls_hash_hd_t handle; - gnutls_hash_deinit(handle, NULL); -} -]])], - [AC_DEFINE(HAVE_GNUTLS3_DIGEST, 1, [Define if using GnuTLS v3 with digest support.])]) + AC_CACHE_CHECK([for GnuTLS v3 with HMAC], [emacs_cv_gnutls3_hmac], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include <gnutls/gnutls.h> + #include <gnutls/crypto.h> + ]], [[ + int + main (void) + { + gnutls_hmac_hd_t handle; + gnutls_hmac_deinit (handle, NULL); + } + ]])], + [emacs_cv_gnutls3_hmac=yes], + [emacs_cv_gnutls3_hmac=no])]) + if test "$emacs_cv_gnutls3_hmac" = yes; then + AC_DEFINE([HAVE_GNUTLS3_HMAC], [1], + [Define if using GnuTLS v3 with HMAC support.]) + fi + + AC_CACHE_CHECK([for GnuTLS v3 with AEAD], [emacs_cv_gnutls3_aead], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include <gnutls/gnutls.h> + #include <gnutls/crypto.h> + ]], [[ + int + main (void) + { + gnutls_aead_cipher_hd_t handle; + gnutls_aead_cipher_deinit (handle); + } + ]])], + [emacs_cv_gnutls3_aead=yes], + [emacs_cv_gnutls3_aead=no])]) + if test "$emacs_cv_gnutls3_aead" = yes; then + AC_DEFINE([HAVE_GNUTLS3_AEAD], [1], + [Define if using GnuTLS v3 with AEAD support.]) + fi + + AC_CACHE_CHECK([for GnuTLS v3 with cipher], [emacs_cv_gnutls3_cipher], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include <gnutls/gnutls.h> + #include <gnutls/crypto.h> + ]], [[ + int + main (void) + { + gnutls_cipher_hd_t handle; + gnutls_cipher_encrypt2 (handle, NULL, 0, NULL, 0); + gnutls_cipher_deinit (handle); + } + ]])], + [emacs_cv_gnutls3_cipher=yes], + [emacs_cv_gnutls3_cipher=no])]) + if test "$emacs_cv_gnutls3_cipher" = yes; then + AC_DEFINE([HAVE_GNUTLS3_CIPHER], [1], + [Define if using GnuTLS v3 with cipher support.]) + fi + + AC_CACHE_CHECK([for GnuTLS v3 with digest], [emacs_cv_gnutls3_digest], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include <gnutls/gnutls.h> + #include <gnutls/crypto.h> + ]], [[ + int + main (void) + { + gnutls_hash_hd_t handle; + gnutls_hash_deinit (handle, NULL); + } + ]])], + [emacs_cv_gnutls3_digest=yes], + [emacs_cv_gnutls3_digest=no])]) + if test "$emacs_cv_gnutls3_digest" = yes; then + AC_DEFINE([HAVE_GNUTLS3_DIGEST], [1], + [Define if using GnuTLS v3 with digest support.]) + fi fi # Windows loads GnuTLS dynamically diff --git a/src/fns.c b/src/fns.c index b678a482bbc..fb1296bc6f0 100644 --- a/src/fns.c +++ b/src/fns.c @@ -46,10 +46,6 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t, enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); -static Lisp_Object -secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, - Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, - Lisp_Object binary); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */ @@ -4767,29 +4763,24 @@ DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms, (BUFFER-OR-STRING-OR-SYMBOL START END CODING-SYSTEM NOERROR) which behave as specified with `secure-hash' and in Info node `(elisp)Format of GnuTLS Cryptography Inputs'. */ -const char* +char * extract_data_from_object (Lisp_Object spec, ptrdiff_t *start_byte, ptrdiff_t *end_byte) { - ptrdiff_t size, start_char = 0, end_char = 0; - register EMACS_INT b, e; - register struct buffer *bp; - EMACS_INT temp; + Lisp_Object object = XCAR (spec); - Lisp_Object object = XCAR (spec); + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object start = CAR_SAFE (spec); - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object start = (CONSP (spec)) ? XCAR (spec) : Qnil; + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object end = CAR_SAFE (spec); - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object end = (CONSP (spec)) ? XCAR (spec) : Qnil; + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object coding_system = CAR_SAFE (spec); - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object coding_system = (CONSP (spec)) ? XCAR (spec) : Qnil; - - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object noerror = (CONSP (spec)) ? XCAR (spec) : Qnil; + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object noerror = CAR_SAFE (spec); if (STRINGP (object)) { @@ -4817,7 +4808,7 @@ extract_data_from_object (Lisp_Object spec, if (STRING_MULTIBYTE (object)) object = code_convert_string (object, coding_system, Qnil, 1, 0, 1); - size = SCHARS (object); + ptrdiff_t size = SCHARS (object), start_char, end_char; validate_subarray (object, start, end, size, &start_char, &end_char); *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); @@ -4828,12 +4819,13 @@ extract_data_from_object (Lisp_Object spec, else if (BUFFERP (object)) { struct buffer *prev = current_buffer; + EMACS_INT b, e; record_unwind_current_buffer (); CHECK_BUFFER (object); - bp = XBUFFER (object); + struct buffer *bp = XBUFFER (object); set_buffer_internal (bp); if (NILP (start)) @@ -4853,7 +4845,11 @@ extract_data_from_object (Lisp_Object spec, } if (b > e) - temp = b, b = e, e = temp; + { + EMACS_INT temp = b; + b = e; + e = temp; + } if (!(BEGV <= b && e <= ZV)) args_out_of_range (start, end); @@ -4932,14 +4928,13 @@ extract_data_from_object (Lisp_Object spec, else if (EQ (object, Qiv_auto)) { #ifdef HAVE_GNUTLS3 - // Format: (iv-auto REQUIRED-LENGTH) + /* Format: (iv-auto REQUIRED-LENGTH). */ - if (! INTEGERP (start)) + if (! NATNUMP (start)) error ("Without a length, iv-auto can't be used. See manual."); else { - /* Make sure the value of "start" doesn't change. */ - size_t start_hold = XUINT (start); + EMACS_INT start_hold = XFASTINT (start); object = make_uninit_string (start_hold); gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold); @@ -4971,7 +4966,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object spec = list5 (object, start, end, coding_system, noerror); - const char* input = extract_data_from_object (spec, &start_byte, &end_byte); + const char *input = extract_data_from_object (spec, &start_byte, &end_byte); if (input == NULL) error ("secure_hash: failed to extract data from object, aborting!"); diff --git a/src/gnutls.c b/src/gnutls.c index 761fe7df3ac..5717b3075c1 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -672,6 +672,13 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte) } } +static char const * +emacs_gnutls_strerror (int err) +{ + char const *str = gnutls_strerror (err); + return str ? str : "unknown"; +} + /* Report a GnuTLS error to the user. Return true if the error code was successfully handled. */ static bool @@ -680,7 +687,6 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) int max_log_level = 0; bool ret; - const char *str; /* TODO: use a Lisp_Object generated by gnutls_make_error? */ if (err >= 0) @@ -692,9 +698,7 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) /* TODO: use gnutls-error-fatalp and gnutls-error-string. */ - str = gnutls_strerror (err); - if (!str) - str = "unknown"; + char const *str = emacs_gnutls_strerror (err); if (gnutls_error_is_fatal (err)) { @@ -708,11 +712,11 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) #endif GNUTLS_LOG2 (level, max_log_level, "fatal error:", str); - ret = 0; + ret = false; } else { - ret = 1; + ret = true; switch (err) { @@ -900,7 +904,7 @@ usage: (gnutls-error-string ERROR) */) if (! TYPE_RANGED_INTEGERP (int, err)) return build_string ("Not an error symbol or code"); - return build_string (gnutls_strerror (XINT (err))); + return build_string (emacs_gnutls_strerror (XINT (err))); } DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, @@ -1592,9 +1596,9 @@ one trustfile (usually a CA bundle). */) XPROCESS (proc)->gnutls_x509_cred = x509_cred; verify_flags = Fplist_get (proplist, QCverify_flags); - if (NUMBERP (verify_flags)) + if (TYPE_RANGED_INTEGERP (unsigned int, verify_flags)) { - gnutls_verify_flags = XINT (verify_flags); + gnutls_verify_flags = XFASTINT (verify_flags); GNUTLS_LOG (2, max_log_level, "setting verification flags"); } else if (NILP (verify_flags)) @@ -1818,39 +1822,32 @@ This function may also return `gnutls-e-again', or 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. */) - (void) + (void) { Lisp_Object ciphers = Qnil; - const gnutls_cipher_algorithm_t* gciphers = gnutls_cipher_list (); - for (size_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) + const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list (); + for (ptrdiff_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) { - const gnutls_cipher_algorithm_t gca = gciphers[pos]; - - Lisp_Object cp = listn (CONSTYPE_HEAP, 15, - /* A symbol representing the cipher */ - intern (gnutls_cipher_get_name (gca)), - /* The internally meaningful cipher ID */ - QCcipher_id, - make_number (gca), - /* The type (vs. other GnuTLS objects). */ - QCtype, - Qgnutls_type_cipher, - /* The tag size (nonzero means AEAD). */ - QCcipher_aead_capable, - (gnutls_cipher_get_tag_size (gca) == 0) ? Qnil : Qt, - /* The tag size (nonzero means AEAD). */ - QCcipher_tagsize, - make_number (gnutls_cipher_get_tag_size (gca)), - /* The block size */ - QCcipher_blocksize, - make_number (gnutls_cipher_get_block_size (gca)), - /* The key size */ - QCcipher_keysize, - make_number (gnutls_cipher_get_key_size (gca)), - /* IV size */ - QCcipher_ivsize, - make_number (gnutls_cipher_get_iv_size (gca))); + gnutls_cipher_algorithm_t gca = gciphers[pos]; + Lisp_Object cipher_symbol = intern (gnutls_cipher_get_name (gca)); + 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), + QCtype, Qgnutls_type_cipher, + QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt, + QCcipher_tagsize, make_number (cipher_tag_size), + + QCcipher_blocksize, + make_number (gnutls_cipher_get_block_size (gca)), + + QCcipher_keysize, + make_number (gnutls_cipher_get_key_size (gca)), + + QCcipher_ivsize, + make_number (gnutls_cipher_get_iv_size (gca))); ciphers = Fcons (cp, ciphers); } @@ -1861,36 +1858,35 @@ The alist key is the cipher name. */) static Lisp_Object gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object cipher, - const char* kdata, size_t ksize, - const char* vdata, size_t vsize, - const char* idata, size_t isize, + const char *kdata, ptrdiff_t ksize, + const char *vdata, ptrdiff_t vsize, + const char *idata, ptrdiff_t isize, Lisp_Object aead_auth) { #ifdef HAVE_GNUTLS3_AEAD - const char* desc = (encrypting ? "encrypt" : "decrypt"); - int ret = GNUTLS_E_SUCCESS; + const char *desc = encrypting ? "encrypt" : "decrypt"; Lisp_Object actual_iv = make_unibyte_string (vdata, vsize); gnutls_aead_cipher_hd_t acipher; - gnutls_datum_t key_datum = { (unsigned char*) kdata, ksize }; - ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum); + gnutls_datum_t key_datum = { (unsigned char *) kdata, ksize }; + int ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS AEAD cipher %s/%s initialization failed: %s", - gnutls_cipher_get_name (gca), desc, str); - } - - size_t storage_length = isize + gnutls_cipher_get_tag_size (gca); + error ("GnuTLS AEAD cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); + + ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); + ptrdiff_t tagged_size; + if (INT_ADD_WRAPV (isize, cipher_tag_size, &tagged_size) + || SIZE_MAX < tagged_size) + memory_full (SIZE_MAX); + size_t storage_length = tagged_size; USE_SAFE_ALLOCA; - unsigned char *storage = SAFE_ALLOCA (storage_length); + char *storage = SAFE_ALLOCA (storage_length); - const char* aead_auth_data = NULL; - size_t aead_auth_size = 0; + const char *aead_auth_data = NULL; + ptrdiff_t aead_auth_size = 0; if (!NILP (aead_auth)) { @@ -1900,8 +1896,8 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, CHECK_CONS (aead_auth); ptrdiff_t astart_byte, aend_byte; - const char* adata = extract_data_from_object (aead_auth, &astart_byte, &aend_byte); - + const char *adata + = extract_data_from_object (aead_auth, &astart_byte, &aend_byte); if (adata == NULL) error ("GnuTLS AEAD cipher auth extraction failed"); @@ -1909,53 +1905,38 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, aead_auth_size = aend_byte - astart_byte; } - size_t expected_remainder = 0; - - if (!encrypting) - expected_remainder = gnutls_cipher_get_tag_size (gca); + ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size; + ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca); - if ((isize - expected_remainder) % gnutls_cipher_get_block_size (gca) != 0) - error ("GnuTLS AEAD cipher %s/%s input block length %ld was not a " - "multiple of the required %ld plus the expected tag remainder %ld", + if (isize < expected_remainder + || (isize - expected_remainder) % cipher_block_size != 0) + error (("GnuTLS AEAD cipher %s/%s input block length %"pD"d " + "is not %"pD"d greater than a multiple of the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - (long) isize, (long) gnutls_cipher_get_block_size (gca), - (long) expected_remainder); - - if (encrypting) - ret = gnutls_aead_cipher_encrypt (acipher, - vdata, vsize, - aead_auth_data, aead_auth_size, - gnutls_cipher_get_tag_size (gca), - idata, isize, - storage, &storage_length); - else - ret = gnutls_aead_cipher_decrypt (acipher, - vdata, vsize, - aead_auth_data, aead_auth_size, - gnutls_cipher_get_tag_size (gca), - idata, isize, - storage, &storage_length); + isize, expected_remainder, cipher_block_size); + + ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt) + (acipher, vdata, vsize, aead_auth_data, aead_auth_size, + cipher_tag_size, idata, isize, storage, &storage_length)); if (ret < GNUTLS_E_SUCCESS) { memset (storage, 0, storage_length); SAFE_FREE (); gnutls_aead_cipher_deinit (acipher); - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; error ("GnuTLS AEAD cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, str); + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); } gnutls_aead_cipher_deinit (acipher); - Lisp_Object output = make_unibyte_string ((const char *)storage, storage_length); + Lisp_Object output = make_unibyte_string (storage, storage_length); memset (storage, 0, storage_length); SAFE_FREE (); return list2 (output, actual_iv); #else - error ("GnuTLS AEAD cipher %ld was invalid or not found", (long) gca); + printmax_t print_gca = gca; + error ("GnuTLS AEAD cipher %"pMd" is invalid or not found", print_gca); #endif } @@ -1980,9 +1961,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, CHECK_CONS (iv); - const char* desc = (encrypting ? "encrypt" : "decrypt"); - - int ret = GNUTLS_E_SUCCESS; + const char *desc = encrypting ? "encrypt" : "decrypt"; gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN; @@ -1992,7 +1971,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (SYMBOLP (cipher)) info = XCDR (Fassq (cipher, Fgnutls_ciphers ())); - else if (INTEGERP (cipher)) + else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher)) gca = XINT (cipher); else info = cipher; @@ -2000,41 +1979,44 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCcipher_id); - if (INTEGERP (v)) + if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, v)) gca = XINT (v); } - if (gca == GNUTLS_CIPHER_UNKNOWN) - error ("GnuTLS cipher was invalid or not found"); + ptrdiff_t key_size = gnutls_cipher_get_key_size (gca); + if (key_size == 0) + error ("GnuTLS cipher is invalid or not found"); ptrdiff_t kstart_byte, kend_byte; - const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); + const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); if (kdata == NULL) error ("GnuTLS cipher key extraction failed"); - if ((kend_byte - kstart_byte) != gnutls_cipher_get_key_size (gca)) - error ("GnuTLS cipher %s/%s key length %" pD "d was not equal to " - "the required %ld", + if (kend_byte - kstart_byte != key_size) + error (("GnuTLS cipher %s/%s key length %"pD"d is not equal to " + "the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - kend_byte - kstart_byte, (long) gnutls_cipher_get_key_size (gca)); + kend_byte - kstart_byte, key_size); ptrdiff_t vstart_byte, vend_byte; - const char* vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte); + char *vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte); if (vdata == NULL) error ("GnuTLS cipher IV extraction failed"); - if ((vend_byte - vstart_byte) != gnutls_cipher_get_iv_size (gca)) - error ("GnuTLS cipher %s/%s IV length %" pD "d was not equal to " - "the required %ld", + ptrdiff_t iv_size = gnutls_cipher_get_iv_size (gca); + if (vend_byte - vstart_byte != iv_size) + error (("GnuTLS cipher %s/%s IV length %"pD"d is not equal to " + "the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - vend_byte - vstart_byte, (long) gnutls_cipher_get_iv_size (gca)); + vend_byte - vstart_byte, iv_size); Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte); ptrdiff_t istart_byte, iend_byte; - const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + const char *idata + = extract_data_from_object (input, &istart_byte, &iend_byte); if (idata == NULL) error ("GnuTLS cipher input extraction failed"); @@ -2053,44 +2035,34 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, return aead_output; } - if ((iend_byte - istart_byte) % gnutls_cipher_get_block_size (gca) != 0) - error ("GnuTLS cipher %s/%s input block length %" pD "d was not a multiple " - "of the required %ld", + ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca); + if ((iend_byte - istart_byte) % cipher_block_size != 0) + error (("GnuTLS cipher %s/%s input block length %"pD"d is not a multiple " + "of the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - iend_byte - istart_byte, (long) gnutls_cipher_get_block_size (gca)); + iend_byte - istart_byte, cipher_block_size); gnutls_cipher_hd_t hcipher; - gnutls_datum_t key_datum = { (unsigned char*) kdata, kend_byte - kstart_byte }; + gnutls_datum_t key_datum + = { (unsigned char *) kdata, kend_byte - kstart_byte }; - ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL); + int ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS cipher %s/%s initialization failed: %s", - gnutls_cipher_get_name (gca), desc, str); - } + error ("GnuTLS cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); /* Note that this will not support streaming block mode. */ - gnutls_cipher_set_iv (hcipher, (void*) vdata, vend_byte - vstart_byte); + gnutls_cipher_set_iv (hcipher, vdata, vend_byte - vstart_byte); - /* - * GnuTLS docs: "For the supported ciphers the encrypted data length - * will equal the plaintext size." - */ - size_t storage_length = iend_byte - istart_byte; + /* GnuTLS docs: "For the supported ciphers the encrypted data length + will equal the plaintext size." */ + ptrdiff_t storage_length = iend_byte - istart_byte; Lisp_Object storage = make_uninit_string (storage_length); - if (encrypting) - ret = gnutls_cipher_encrypt2 (hcipher, - idata, iend_byte - istart_byte, - SSDATA (storage), storage_length); - else - ret = gnutls_cipher_decrypt2 (hcipher, - idata, iend_byte - istart_byte, - SSDATA (storage), storage_length); + ret = ((encrypting ? gnutls_cipher_encrypt2 : gnutls_cipher_decrypt2) + (hcipher, idata, iend_byte - istart_byte, + SSDATA (storage), storage_length)); if (STRINGP (XCAR (key))) Fclear_string (XCAR (key)); @@ -2098,11 +2070,8 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (ret < GNUTLS_E_SUCCESS) { gnutls_cipher_deinit (hcipher); - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; error ("GnuTLS cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, str); + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); } gnutls_cipher_deinit (hcipher); @@ -2110,41 +2079,46 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, return list2 (storage, actual_iv); } -DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, Sgnutls_symmetric_encrypt, 4, 5, 0, +DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, + Sgnutls_symmetric_encrypt, 4, 5, 0, doc: /* Encrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. -Returns nil on error. +Return nil on error. -The KEY can be specified as a buffer or string or in other ways -(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be -wiped after use if it's a string. +The KEY can be specified as a buffer or string or in other ways (see +Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY +will be wiped after use if it's a string. -The IV and INPUT and the optional AEAD_AUTH can be -specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). +The IV and INPUT and the optional AEAD_AUTH can be specified as a +buffer or string or in other ways (see Info node `(elisp)Format of +GnuTLS Cryptography Inputs'). The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. The CIPHER may be a string or symbol matching a key in that alist, or -a plist with the `:cipher-id' numeric property, or the number itself. +a plist with the :cipher-id numeric property, or the number itself. AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with :cipher-aead-capable set to t. AEAD_AUTH can be supplied for these AEAD ciphers, but it may still be omitted (nil) as well. */) - (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, + Lisp_Object input, Lisp_Object aead_auth) { return gnutls_symmetric (true, cipher, key, iv, input, aead_auth); } -DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt, Sgnutls_symmetric_decrypt, 4, 5, 0, +DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt, + Sgnutls_symmetric_decrypt, 4, 5, 0, doc: /* Decrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. -Returns nil on error. +Return nil on error. -The KEY can be specified as a buffer or string or in other ways -(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be -wiped after use if it's a string. +The KEY can be specified as a buffer or string or in other ways (see +Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY +will be wiped after use if it's a string. -The IV and INPUT and the optional AEAD_AUTH can be -specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). +The IV and INPUT and the optional AEAD_AUTH can be specified as a +buffer or string or in other ways (see Info node `(elisp)Format of +GnuTLS Cryptography Inputs'). The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. The CIPHER may be a string or symbol matching a key in that alist, or @@ -2153,7 +2127,8 @@ a plist with the `:cipher-id' numeric property, or the number itself. AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with :cipher-aead-capable set to t. AEAD_AUTH can be supplied for these AEAD ciphers, but it may still be omitted (nil) as well. */) - (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, + Lisp_Object input, Lisp_Object aead_auth) { return gnutls_symmetric (false, cipher, key, iv, input, aead_auth); } @@ -2164,32 +2139,26 @@ DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0, Use the value of the alist (extract it with `alist-get' for instance) with `gnutls-hash-mac'. The alist key is the mac-algorithm method name. */) - (void) + (void) { Lisp_Object mac_algorithms = Qnil; - const gnutls_mac_algorithm_t* macs = gnutls_mac_list (); - for (size_t pos = 0; macs[pos] != 0; pos++) + const gnutls_mac_algorithm_t *macs = gnutls_mac_list (); + for (ptrdiff_t pos = 0; macs[pos] != 0; pos++) { const gnutls_mac_algorithm_t gma = macs[pos]; - const char* name = gnutls_mac_get_name (gma); - - Lisp_Object mp = listn (CONSTYPE_HEAP, 11, - /* A symbol representing the mac-algorithm. */ - intern (name), - /* The internally meaningful mac-algorithm ID. */ - QCmac_algorithm_id, - make_number (gma), - /* The type (vs. other GnuTLS objects). */ - QCtype, - Qgnutls_type_mac_algorithm, - /* The output length. */ + const char *name = gnutls_mac_get_name (gma); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 11, intern (name), + QCmac_algorithm_id, make_number (gma), + QCtype, Qgnutls_type_mac_algorithm, + QCmac_algorithm_length, make_number (gnutls_hmac_get_len (gma)), - /* The key size. */ + QCmac_algorithm_keysize, make_number (gnutls_mac_get_key_size (gma)), - /* The nonce size. */ + QCmac_algorithm_noncesize, make_number (gnutls_mac_get_nonce_size (gma))); mac_algorithms = Fcons (mp, mac_algorithms); @@ -2204,25 +2173,20 @@ DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0, Use the value of the alist (extract it with `alist-get' for instance) with `gnutls-hash-digest'. The alist key is the digest-algorithm method name. */) - (void) + (void) { Lisp_Object digest_algorithms = Qnil; - const gnutls_digest_algorithm_t* digests = gnutls_digest_list (); - for (size_t pos = 0; digests[pos] != 0; pos++) + const gnutls_digest_algorithm_t *digests = gnutls_digest_list (); + for (ptrdiff_t pos = 0; digests[pos] != 0; pos++) { const gnutls_digest_algorithm_t gda = digests[pos]; - const char* name = gnutls_digest_get_name (gda); - - Lisp_Object mp = listn (CONSTYPE_HEAP, 7, - /* A symbol representing the digest-algorithm. */ - intern (name), - /* The internally meaningful digest-algorithm ID. */ - QCdigest_algorithm_id, - make_number (gda), - QCtype, - Qgnutls_type_digest_algorithm, - /* The digest length. */ + const char *name = gnutls_digest_get_name (gda); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 7, intern (name), + QCdigest_algorithm_id, make_number (gda), + QCtype, Qgnutls_type_digest_algorithm, + QCdigest_algorithm_length, make_number (gnutls_hash_get_len (gda))); @@ -2235,11 +2199,11 @@ method name. */) DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0, doc: /* Hash INPUT with HASH-METHOD and KEY into a unibyte string. -Returns nil on error. +Return nil on error. -The KEY can be specified as a buffer or string or in other ways -(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be -wiped after use if it's a string. +The KEY can be specified as a buffer or string or in other ways (see +Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY +will be wiped after use if it's a string. The INPUT can be specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). @@ -2248,7 +2212,7 @@ The alist of MAC algorithms can be obtained with `gnutls-macs`. The HASH-METHOD may be a string or symbol matching a key in that alist, or a plist with the `:mac-algorithm-id' numeric property, or the number itself. */) - (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input) + (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input) { if (BUFFERP (input) || STRINGP (input)) input = list1 (input); @@ -2260,8 +2224,6 @@ itself. */) CHECK_CONS (key); - int ret = GNUTLS_E_SUCCESS; - gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN; Lisp_Object info = Qnil; @@ -2270,7 +2232,7 @@ itself. */) if (SYMBOLP (hash_method)) info = XCDR (Fassq (hash_method, Fgnutls_macs ())); - else if (INTEGERP (hash_method)) + else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method)) gma = XINT (hash_method); else info = hash_method; @@ -2278,37 +2240,32 @@ itself. */) if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); - if (INTEGERP (v)) + if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, v)) gma = XINT (v); } - if (gma == GNUTLS_MAC_UNKNOWN) - error ("GnuTLS MAC-method was invalid or not found"); + ptrdiff_t digest_length = gnutls_hmac_get_len (gma); + if (digest_length == 0) + error ("GnuTLS MAC-method is invalid or not found"); ptrdiff_t kstart_byte, kend_byte; - const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); - gnutls_hmac_hd_t hmac; - ret = gnutls_hmac_init (&hmac, gma, - kdata + kstart_byte, kend_byte - kstart_byte); - + const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); if (kdata == NULL) error ("GnuTLS MAC key extraction failed"); + gnutls_hmac_hd_t hmac; + int ret = gnutls_hmac_init (&hmac, gma, + kdata + kstart_byte, kend_byte - kstart_byte); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS MAC %s initialization failed: %s", - gnutls_mac_get_name (gma), str); - } + error ("GnuTLS MAC %s initialization failed: %s", + gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret)); ptrdiff_t istart_byte, iend_byte; - const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + const char *idata + = extract_data_from_object (input, &istart_byte, &iend_byte); if (idata == NULL) error ("GnuTLS MAC input extraction failed"); - size_t digest_length = gnutls_hmac_get_len (gma); Lisp_Object digest = make_uninit_string (digest_length); ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte); @@ -2319,12 +2276,8 @@ itself. */) if (ret < GNUTLS_E_SUCCESS) { gnutls_hmac_deinit (hmac, NULL); - - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; error ("GnuTLS MAC %s application failed: %s", - gnutls_mac_get_name (gma), str); + gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret)); } gnutls_hmac_output (hmac, SSDATA (digest)); @@ -2336,7 +2289,7 @@ itself. */) DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0, doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string. -Returns nil on error. +Return nil on error. The INPUT can be specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). @@ -2345,15 +2298,13 @@ The alist of digest algorithms can be obtained with `gnutls-digests`. The DIGEST-METHOD may be a string or symbol matching a key in that alist, or a plist with the `:digest-algorithm-id' numeric property, or the number itself. */) - (Lisp_Object digest_method, Lisp_Object input) + (Lisp_Object digest_method, Lisp_Object input) { if (BUFFERP (input) || STRINGP (input)) input = list1 (input); CHECK_CONS (input); - int ret = GNUTLS_E_SUCCESS; - gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN; Lisp_Object info = Qnil; @@ -2362,7 +2313,7 @@ the number itself. */) if (SYMBOLP (digest_method)) info = XCDR (Fassq (digest_method, Fgnutls_digests ())); - else if (INTEGERP (digest_method)) + else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method)) gda = XINT (digest_method); else info = digest_method; @@ -2370,29 +2321,26 @@ the number itself. */) if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); - if (INTEGERP (v)) + if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, v)) gda = XINT (v); } - if (gda == GNUTLS_DIG_UNKNOWN) - error ("GnuTLS digest-method was invalid or not found"); + ptrdiff_t digest_length = gnutls_hash_get_len (gda); + if (digest_length == 0) + error ("GnuTLS digest-method is invalid or not found"); gnutls_hash_hd_t hash; - ret = gnutls_hash_init (&hash, gda); + int ret = gnutls_hash_init (&hash, gda); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS digest initialization failed: %s", str); - } + error ("GnuTLS digest initialization failed: %s", + emacs_gnutls_strerror (ret)); - size_t digest_length = gnutls_hash_get_len (gda); Lisp_Object digest = make_uninit_string (digest_length); ptrdiff_t istart_byte, iend_byte; - const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + const char *idata + = extract_data_from_object (input, &istart_byte, &iend_byte); if (idata == NULL) error ("GnuTLS digest input extraction failed"); @@ -2401,11 +2349,8 @@ the number itself. */) if (ret < GNUTLS_E_SUCCESS) { gnutls_hash_deinit (hash, NULL); - - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS digest application failed: %s", str); + error ("GnuTLS digest application failed: %s", + emacs_gnutls_strerror (ret)); } gnutls_hash_output (hash, SSDATA (digest)); @@ -2420,57 +2365,51 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs. ...if supported : then... -GnuTLS 3 or higher : the list will contain 'gnutls3. -GnuTLS MACs : the list will contain 'macs. -GnuTLS digests : the list will contain 'digests. -GnuTLS symmetric ciphers: the list will contain 'ciphers. -GnuTLS AEAD ciphers : the list will contain 'AEAD-ciphers. */) - (void) +GnuTLS 3 or higher : the list will contain `gnutls3'. +GnuTLS MACs : the list will contain `macs'. +GnuTLS digests : the list will contain `digests'. +GnuTLS symmetric ciphers: the list will contain `ciphers'. +GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) + (void) { -#ifdef HAVE_GNUTLS - Lisp_Object capabilities = Qnil; +#ifdef WINDOWSNT + Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); + if (CONSP (found)) + return XCDR (found); /* TODO: use capabilities. */ + else + { + Lisp_Object status; + /* TODO: should the capabilities be dynamic here? */ + status = init_gnutls_functions () ? capabilities : Qnil; + Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); + return status; + } +#else -#ifdef HAVE_GNUTLS3 + Lisp_Object capabilities = Qnil; +# ifdef HAVE_GNUTLS3 capabilities = Fcons (intern("gnutls3"), capabilities); -#ifdef HAVE_GNUTLS3_DIGEST +# ifdef HAVE_GNUTLS3_DIGEST capabilities = Fcons (intern("digests"), capabilities); -#endif +# endif -#ifdef HAVE_GNUTLS3_CIPHER +# ifdef HAVE_GNUTLS3_CIPHER capabilities = Fcons (intern("ciphers"), capabilities); -#ifdef HAVE_GNUTLS3_AEAD +# ifdef HAVE_GNUTLS3_AEAD capabilities = Fcons (intern("AEAD-ciphers"), capabilities); -#endif +# endif -#ifdef HAVE_GNUTLS3_HMAC +# ifdef HAVE_GNUTLS3_HMAC capabilities = Fcons (intern("macs"), capabilities); -#endif - -#endif - -#endif +# endif +# endif +# endif -# ifdef WINDOWSNT - Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); - if (CONSP (found)) - return XCDR (found); // TODO: use capabilities. - else - { - Lisp_Object status; - // TODO: should the capabilities be dynamic here? - status = init_gnutls_functions () ? capabilities : Qnil; - Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); - return status; - } -# else /* !WINDOWSNT */ return capabilities; -# endif /* !WINDOWSNT */ -#else /* !HAVE_GNUTLS */ - return Qnil; -#endif /* !HAVE_GNUTLS */ +#endif } void diff --git a/src/lisp.h b/src/lisp.h index a5134a9532c..9464bf8559f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3386,9 +3386,7 @@ enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); extern void sweep_weak_hash_tables (void); -extern const char* extract_data_from_object (Lisp_Object spec, - ptrdiff_t *start_byte, - ptrdiff_t *end_byte); +extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, |