andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

GnuTLS integer-overflow and style fixes

Browse source 
This tweaks the recently-added GnuTLS improvements so that
they avoid some integer-overflow problems and follow typical
Emacs style a bit better.
* configure.ac (HAVE_GNUTLS3_HMAC, HAVE_GNUTLS3_AEAD)
(HAVE_GNUTLS3_CIPHER): Use AC_CACHE_CHECK so that the
configure-time results are displayed.
* src/fns.c (extract_data_from_object): Return char *, not char
const *, since one gnutls caller wants a non-const pointer.  Use
CONSP rather than !NILP when testing for conses.  Use CAR_SAFE
instead of rolling our own code.  Prefer signed types to unsigned
when either will do.  Report problems for lengths out of range,
instead of silently mishandling them.
* src/gnutls.c (emacs_gnutls_strerror): New function, to simplify
callers.  All callers of gnutls_sterror changed.
(Fgnutls_boot): Check for integers out of range rather than
silently truncating them.
(gnutls_symmetric_aead): Check for integer overflow in size
calculations.
(gnutls_symmetric_aead, Fgnutls_macs, Fgnutls_digests):
Prefer signed to unsigned integers where either	will do.
(gnutls_symmetric_aead, gnutls_symmetric):
Work even if ptrdiff_t is wider than ‘long’.
(gnutls_symmetric, Fgnutls_hash_mac, Fgnutls_hash_digest):
Check for integer overflow in algorithm selection.
This commit is contained in:
Paul Eggert 2017-07-14 16:18:37 -07:00
parent 8b64a80a56
commit 05b8b86699
4 changed files with 312 additions and 354 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

128
configure.ac
View file

@ -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_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_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_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_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_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_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 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

49
src/fns.c
View file

@ -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!");

485
src/gnutls.c
View file

@ -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];
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,
/* 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)));
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);
}
error ("GnuTLS AEAD cipher %s/%s initialization failed: %s",
gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret));
size_t storage_length = isize + gnutls_cipher_get_tag_size (gca);
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;
ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size;
ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
if (!encrypting)
expected_remainder = gnutls_cipher_get_tag_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);
isize, expected_remainder, cipher_block_size);
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);
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);
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,
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. */
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);
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,
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. */
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 HAVE_GNUTLS3
capabilities = Fcons (intern("gnutls3"), capabilities);
#ifdef HAVE_GNUTLS3_DIGEST
capabilities = Fcons (intern("digests"), capabilities);
#endif
#ifdef HAVE_GNUTLS3_CIPHER
capabilities = Fcons (intern("ciphers"), capabilities);
#ifdef HAVE_GNUTLS3_AEAD
capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
#endif
#ifdef HAVE_GNUTLS3_HMAC
capabilities = Fcons (intern("macs"), capabilities);
#endif
#endif
#endif
# ifdef WINDOWSNT
#ifdef WINDOWSNT
Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
if (CONSP (found))
return XCDR (found); // TODO: use capabilities.
return XCDR (found); /* TODO: use capabilities. */
else
{
Lisp_Object status;
// TODO: should the capabilities be dynamic here?
/* 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 */
#else
Lisp_Object capabilities = Qnil;
# ifdef HAVE_GNUTLS3
capabilities = Fcons (intern("gnutls3"), capabilities);
# ifdef HAVE_GNUTLS3_DIGEST
capabilities = Fcons (intern("digests"), capabilities);
# endif
# ifdef HAVE_GNUTLS3_CIPHER
capabilities = Fcons (intern("ciphers"), capabilities);
# ifdef HAVE_GNUTLS3_AEAD
capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
# endif
# ifdef HAVE_GNUTLS3_HMAC
capabilities = Fcons (intern("macs"), capabilities);
# endif
# endif
# endif
return capabilities;
# endif /* !WINDOWSNT */
#else /* !HAVE_GNUTLS */
return Qnil;
#endif /* !HAVE_GNUTLS */
#endif
}
void

4
src/lisp.h
View file

@ -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,