From 583995c62dd424775dda33d5134ce04bee2ae685 Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Fri, 14 Jul 2017 11:04:19 -0400 Subject: [PATCH] GnuTLS HMAC and symmetric cipher support * etc/NEWS: Add news for new feature. * doc/lispref/text.texi (GnuTLS Cryptography): Add documentation. * configure.ac: Add macros HAVE_GNUTLS3_DIGEST, HAVE_GNUTLS3_CIPHER, HAVE_GNUTLS3_AEAD, HAVE_GNUTLS3_HMAC. * src/fns.c (Fsecure_hash_algorithms): Add function to list supported `secure-hash' algorithms. (extract_data_from_object): Add data extraction function that can operate on buffers and strings. (secure_hash): Use it. (Fsecure_hash): Mention `secure-hash-algorithms'. * src/gnutls.h: Include gnutls/crypto.h. * src/gnutls.c (Fgnutls_ciphers, gnutls_symmetric_aead) (gnutls_symmetric, Fgnutls_symmetric_encrypt, Fgnutls_symmetric_decrypt) (Fgnutls_macs, Fgnutls_digests, Fgnutls_hash_mac, Fgnutls_hash_digest) (Fgnutls_available_p): Implement GnuTLS cryptographic integration. * test/lisp/net/gnutls-tests.el: Add tests. --- configure.ac | 55 +++ doc/lispref/text.texi | 195 ++++++++++ etc/NEWS | 14 + src/fns.c | 134 +++++-- src/gnutls.c | 674 +++++++++++++++++++++++++++++++++- src/gnutls.h | 4 + src/lisp.h | 3 + test/lisp/net/gnutls-tests.el | 290 +++++++++++++++ 8 files changed, 1340 insertions(+), 29 deletions(-) create mode 100644 test/lisp/net/gnutls-tests.el diff --git a/configure.ac b/configure.ac index 980b4c633ba..525aa51598a 100644 --- a/configure.ac +++ b/configure.ac @@ -2831,6 +2831,61 @@ if test "${with_gnutls}" = "yes" ; then AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.]) 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 +#include +]], +[[ +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 +#include +]], +[[ +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 +#include +]], +[[ +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 +#include +]], +[[ +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.])]) fi # Windows loads GnuTLS dynamically diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 9696c73c484..fd6ddc98fed 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -57,6 +57,7 @@ the character after point. * Decompression:: Dealing with compressed data. * Base 64:: Conversion to or from base 64 encoding. * Checksum/Hash:: Computing cryptographic hashes. +* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS. * Parsing HTML/XML:: Parsing HTML and XML. * Atomic Changes:: Installing several buffer changes atomically. * Change Hooks:: Supplying functions to be run when text is changed. @@ -4436,6 +4437,11 @@ similar theoretical weakness also exists in SHA-1. Therefore, for security-related applications you should use the other hash types, such as SHA-2. +@defun secure-hash-algorithms +This function returns a list of symbols representing algorithms that +@code{secure-hash} can use. +@end defun + @defun secure-hash algorithm object &optional start end binary This function returns a hash for @var{object}. The argument @var{algorithm} is a symbol stating which hash to compute: one of @@ -4494,6 +4500,195 @@ It should be somewhat more efficient on larger buffers than @c according to what we find useful. @end defun +@node GnuTLS Cryptography +@section GnuTLS Cryptography +@cindex MD5 checksum +@cindex SHA hash +@cindex hash, cryptographic +@cindex cryptographic hash +@cindex AEAD cipher +@cindex cipher, AEAD +@cindex symmetric cipher +@cindex cipher, symmetric + +If compiled with GnuTLS, Emacs offers built-in cryptographic support. +Following the GnuTLS API terminology, the available tools are digests, +MACs, symmetric ciphers, and AEAD ciphers. + +The terms used herein, such as IV (Initialization Vector), require +some familiarity with cryptography and will not be defined in detail. +Please consult @uref{https://www.gnutls.org/} for specific +documentation which may help you understand the terminology and +structure of the GnuTLS library. + +@node Format of GnuTLS Cryptography Inputs +@subsection Format of GnuTLS Cryptography Inputs +@cindex format of gnutls cryptography inputs +@cindex gnutls cryptography inputs format + +The inputs to GnuTLS cryptographic functions can be specified in +several ways, both as primitive Emacs Lisp types or as lists. + +The list form is currently similar to how @code{md5} and +@code{secure-hash} operate. + +@table @code +@item @var{buffer} +Simply passing a buffer as input means the whole buffer should be used. + +@item @var{string} +A string as input will be used directly. It may be modified by the +function (unlike most other Emacs Lisp functions) to reduce the chance +of exposing sensitive data after the function does its work. + +@item (@var{buffer-or-string} @var{start} @var{end} @var{coding-system} @var{noerror}) +This specifies a buffer or a string as described above, but an +optional range can be specified with @var{start} and @var{end}. + +In addition an optional @var{coding-system} can be specified if needed. + +The last optional item, @var{noerror}, overrides the normal error when +the text can't be encoded using the specified or chosen coding system. +When @var{noerror} is non-@code{nil}, this function silently uses +@code{raw-text} coding instead. + +@item (@code{iv-auto} @var{length}) +This will generate an IV (Initialization Vector) of the specified +length using the GnuTLS @code{GNUTLS_RND_NONCE} generator and pass it +to the function. This ensures that the IV is unpredictable and +unlikely to be reused in the same session. The actual value of the IV +is returned by the function as described below. + +@end table + +@node GnuTLS Cryptographic Functions +@subsection GnuTLS Cryptographic Functions +@cindex gnutls cryptographic functions + +@defun gnutls-digests +This function returns the alist of the GnuTLS digest algorithms. + +Each entry has a key which represents the algorithm, followed by a +plist with internal details about the algorithm. The plist will have +@code{:type gnutls-digest-algorithm} and also will have the key +@code{:digest-algorithm-length 64} to indicate the size, in bytes, of +the resulting digest. + +There is a name parallel between GnuTLS MAC and digest algorithms but +they are separate things internally and should not be mixed. +@end defun + +@defun gnutls-hash-digest digest-method input +The @var{digest-method} can be the whole plist from +@code{gnutls-digests}, or just the symbol key, or a string with the +name of that symbol. + +The @var{input} can be specified as a buffer or string or in other +ways (@pxref{Format of GnuTLS Cryptography Inputs}). + +This function returns @code{nil} on error, and signals a Lisp error if +the @var{digest-method} or @var{input} are invalid. On success, it +returns a list of a binary string (the output) and the IV used. +@end defun + +@defun gnutls-macs +This function returns the alist of the GnuTLS MAC algorithms. + +Each entry has a key which represents the algorithm, followed by a +plist with internal details about the algorithm. The plist will have +@code{:type gnutls-mac-algorithm} and also will have the keys +@code{:mac-algorithm-length} @code{:mac-algorithm-keysize} +@code{:mac-algorithm-noncesize} to indicate the size, in bytes, of the +resulting hash, the key, and the nonce respectively. + +The nonce is currently unused and only some MACs support it. + +There is a name parallel between GnuTLS MAC and digest algorithms but +they are separate things internally and should not be mixed. +@end defun + +@defun gnutls-hash-mac hash-method key input +The @var{hash-method} can be the whole plist from +@code{gnutls-macs}, or just the symbol key, or a string with the +name of that symbol. + +The @var{key} can be specified as a buffer or string or in other ways +(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be +wiped after use if it's a string. + +The @var{input} can be specified as a buffer or string or in other +ways (@pxref{Format of GnuTLS Cryptography Inputs}). + +This function returns @code{nil} on error, and signals a Lisp error if +the @var{hash-method} or @var{key} or @var{input} are invalid. + +On success, it returns a list of a binary string (the output) and the +IV used. +@end defun + +@defun gnutls-ciphers +This function returns the alist of the GnuTLS ciphers. + +Each entry has a key which represents the cipher, followed by a plist +with internal details about the algorithm. The plist will have +@code{:type gnutls-symmetric-cipher} and also will have the keys +@code{:cipher-aead-capable} set to @code{nil} or @code{t} to indicate +AEAD capability; and @code{:cipher-tagsize} @code{:cipher-blocksize} +@code{:cipher-keysize} @code{:cipher-ivsize} to indicate the size, in +bytes, of the tag, block size of the resulting data, the key, and the +IV respectively. +@end defun + +@defun gnutls-symmetric-encrypt cipher key iv input &optional aead_auth +The @var{cipher} can be the whole plist from +@code{gnutls-ciphers}, or just the symbol key, or a string with the +name of that symbol. + +The @var{key} can be specified as a buffer or string or in other ways +(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be +wiped after use if it's a string. + +The @var{iv} and @var{input} and the optional @var{aead_auth} can be +specified as a buffer or string or in other ways (@pxref{Format of +GnuTLS Cryptography Inputs}). + +@var{aead_auth} is only checked with AEAD ciphers, that is, ciphers whose +plist has @code{:cipher-aead-capable t}. Otherwise it's ignored. + +This function returns @code{nil} on error, and signals a Lisp error if +the @var{cipher} or @var{key}, @var{iv}, or @var{input} are invalid, +or if @var{aead_auth} was specified with an AEAD cipher and was +invalid. + +On success, it returns a list of a binary string (the output) and the +IV used. +@end defun + +@defun gnutls-symmetric-decrypt cipher key iv input &optional aead_auth +The @var{cipher} can be the whole plist from +@code{gnutls-ciphers}, or just the symbol key, or a string with the +name of that symbol. + +The @var{key} can be specified as a buffer or string or in other ways +(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be +wiped after use if it's a string. + +The @var{iv} and @var{input} and the optional @var{aead_auth} can be +specified as a buffer or string or in other ways (@pxref{Format of +GnuTLS Cryptography Inputs}). + +@var{aead_auth} is only checked with AEAD ciphers, that is, ciphers whose +plist has @code{:cipher-aead-capable t}. Otherwise it's ignored. + +This function returns @code{nil} on decryption error, and signals a +Lisp error if the @var{cipher} or @var{key}, @var{iv}, or @var{input} +are invalid, or if @var{aead_auth} was specified with an AEAD cipher +and was invalid. + +On success, it returns a list of a binary string (the output) and the +IV used. +@end defun + @node Parsing HTML/XML @section Parsing HTML and XML @cindex parsing html diff --git a/etc/NEWS b/etc/NEWS index dd6d5465d85..0ab49587d79 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1114,6 +1114,20 @@ break. ** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of the order. +** Checksum/Hash + ++++ +** New function 'secure-hash-algorithms' to list the algorithms that +'secure-hash' supports. +See the node "(elisp) Checksum/Hash" in the ELisp manual for details. + ++++ +** Emacs now exposes the GnuTLS cryptographic API with the functions +'gnutls-macs' and 'gnutls-hash-mac'; 'gnutls-digests' and +'gnutls-hash-digest'; 'gnutls-ciphers' and 'gnutls-symmetric-encrypt' +and 'gnutls-symmetric-decrypt'. +See the node "(elisp) GnuTLS Cryptography" in the ELisp manual for details. + +++ ** Emacs now supports records for user-defined types, via the new functions 'make-record', 'record', and 'recordp'. Records are now diff --git a/src/fns.c b/src/fns.c index f0e10e311f5..8b7fc0f89d8 100644 --- a/src/fns.c +++ b/src/fns.c @@ -35,12 +35,17 @@ along with GNU Emacs. If not, see . */ #include "intervals.h" #include "window.h" #include "puresize.h" +#include "gnutls.h" static void sort_vector_copy (Lisp_Object, ptrdiff_t, Lisp_Object *restrict, Lisp_Object *restrict); 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. */ @@ -4740,22 +4745,47 @@ make_digest_string (Lisp_Object digest, int digest_size) return digest; } -/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ +DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms, + Ssecure_hash_algorithms, 0, 0, 0, + doc: /* Return a list of all the supported `secure_hash' algorithms. */) + (void) +{ + return listn (CONSTYPE_HEAP, 6, + Qmd5, + Qsha1, + Qsha224, + Qsha256, + Qsha384, + Qsha512); +} -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) +/* Extract data from a string or a buffer. SPEC is a list of +(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* +extract_data_from_object (Lisp_Object spec, + ptrdiff_t *start_byte, + ptrdiff_t *end_byte) { - ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte; + ptrdiff_t size, start_char = 0, end_char = 0; register EMACS_INT b, e; register struct buffer *bp; EMACS_INT temp; - int digest_size; - void *(*hash_func) (const char *, size_t, void *); - Lisp_Object digest; - CHECK_SYMBOL (algorithm); + Lisp_Object object = XCAR (spec); + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object start = (CONSP (spec)) ? XCAR (spec) : Qnil; + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object end = (CONSP (spec)) ? XCAR (spec) : Qnil; + + 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 (STRINGP (object)) { @@ -4786,12 +4816,12 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, size = SCHARS (object); validate_subarray (object, start, end, size, &start_char, &end_char); - start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); - end_byte = (end_char == size - ? SBYTES (object) - : string_char_to_byte (object, end_char)); + *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); + *end_byte = (end_char == size + ? SBYTES (object) + : string_char_to_byte (object, end_char)); } - else + else if (BUFFERP (object)) { struct buffer *prev = current_buffer; @@ -4892,10 +4922,56 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, if (STRING_MULTIBYTE (object)) object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); - start_byte = 0; - end_byte = SBYTES (object); + *start_byte = 0; + *end_byte = SBYTES (object); + } + else if (EQ (object, Qiv_auto)) + { +#ifdef HAVE_GNUTLS3 + // Format: (iv-auto REQUIRED-LENGTH) + + if (! INTEGERP (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); + object = make_uninit_string (start_hold); + gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold); + + *start_byte = 0; + *end_byte = start_hold; + } +#else + error ("GnuTLS integration is not available, so iv-auto can't be used."); +#endif } + return SSDATA (object); +} + + +/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ + +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) +{ + ptrdiff_t start_byte, end_byte; + int digest_size; + void *(*hash_func) (const char *, size_t, void *); + Lisp_Object digest; + + CHECK_SYMBOL (algorithm); + + Lisp_Object spec = list5 (object, start, end, coding_system, noerror); + + 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!"); + if (EQ (algorithm, Qmd5)) { digest_size = MD5_DIGEST_SIZE; @@ -4933,7 +5009,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, hexified value */ digest = make_uninit_string (digest_size * 2); - hash_func (SSDATA (object) + start_byte, + hash_func (input + start_byte, end_byte - start_byte, SSDATA (digest)); @@ -4984,6 +5060,8 @@ The two optional arguments START and END are positions specifying for which part of OBJECT to compute the hash. If nil or omitted, uses the whole OBJECT. +The full list of algorithms can be obtained with `secure-hash-algorithms'. + If BINARY is non-nil, returns a string in binary form. */) (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary) { @@ -5031,13 +5109,6 @@ disregarding any coding systems. If nil, use the current buffer. */ ) void syms_of_fns (void) { - DEFSYM (Qmd5, "md5"); - DEFSYM (Qsha1, "sha1"); - DEFSYM (Qsha224, "sha224"); - DEFSYM (Qsha256, "sha256"); - DEFSYM (Qsha384, "sha384"); - DEFSYM (Qsha512, "sha512"); - /* Hash table stuff. */ DEFSYM (Qhash_table_p, "hash-table-p"); DEFSYM (Qeq, "eq"); @@ -5074,6 +5145,18 @@ syms_of_fns (void) defsubr (&Smaphash); defsubr (&Sdefine_hash_table_test); + /* Crypto and hashing stuff. */ + DEFSYM (Qiv_auto, "iv-auto"); + + DEFSYM (Qmd5, "md5"); + DEFSYM (Qsha1, "sha1"); + DEFSYM (Qsha224, "sha224"); + DEFSYM (Qsha256, "sha256"); + DEFSYM (Qsha384, "sha384"); + DEFSYM (Qsha512, "sha512"); + + /* Miscellaneous stuff. */ + DEFSYM (Qstring_lessp, "string-lessp"); DEFSYM (Qprovide, "provide"); DEFSYM (Qrequire, "require"); @@ -5192,6 +5275,7 @@ this variable. */); defsubr (&Sbase64_encode_string); defsubr (&Sbase64_decode_string); defsubr (&Smd5); + defsubr (&Ssecure_hash_algorithms); defsubr (&Ssecure_hash); defsubr (&Sbuffer_hash); defsubr (&Slocale_info); diff --git a/src/gnutls.c b/src/gnutls.c index 2078ad88f28..7a4e92f0d3f 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include "process.h" #include "gnutls.h" #include "coding.h" +#include "buffer.h" #ifdef HAVE_GNUTLS @@ -1697,24 +1698,660 @@ This function may also return `gnutls-e-again', or #endif /* HAVE_GNUTLS */ +#ifdef HAVE_GNUTLS3 + +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) +{ + 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 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))); + + ciphers = Fcons (cp, ciphers); + } + + return ciphers; +} + +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, + Lisp_Object aead_auth) +{ +#ifdef HAVE_GNUTLS3_AEAD + + const char* desc = (encrypting ? "encrypt" : "decrypt"); + int ret = GNUTLS_E_SUCCESS; + 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); + + 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); + USE_SAFE_ALLOCA; + unsigned char *storage = SAFE_ALLOCA (storage_length); + + const char* aead_auth_data = NULL; + size_t aead_auth_size = 0; + + if (!NILP (aead_auth)) + { + if (BUFFERP (aead_auth) || STRINGP (aead_auth)) + aead_auth = list1 (aead_auth); + + CHECK_CONS (aead_auth); + + ptrdiff_t 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"); + + aead_auth_data = adata; + aead_auth_size = aend_byte - astart_byte; + } + + size_t expected_remainder = 0; + + 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", + 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); + + 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_aead_cipher_deinit (acipher); + + Lisp_Object output = make_unibyte_string ((const char *)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); +#endif +} + +static Lisp_Object +gnutls_symmetric (bool encrypting, Lisp_Object cipher, + Lisp_Object key, Lisp_Object iv, + Lisp_Object input, Lisp_Object aead_auth) +{ + if (BUFFERP (key) || STRINGP (key)) + key = list1 (key); + + CHECK_CONS (key); + + if (BUFFERP (input) || STRINGP (input)) + input = list1 (input); + + CHECK_CONS (input); + + if (BUFFERP (iv) || STRINGP (iv)) + iv = list1 (iv); + + CHECK_CONS (iv); + + + const char* desc = (encrypting ? "encrypt" : "decrypt"); + + int ret = GNUTLS_E_SUCCESS; + + gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN; + + Lisp_Object info = Qnil; + if (STRINGP (cipher)) + cipher = intern (SSDATA (cipher)); + + if (SYMBOLP (cipher)) + info = XCDR (Fassq (cipher, Fgnutls_ciphers ())); + else if (INTEGERP (cipher)) + gca = XINT (cipher); + else + info = cipher; + + if (!NILP (info) && CONSP (info)) + { + Lisp_Object v = Fplist_get (info, QCcipher_id); + if (INTEGERP (v)) + gca = XINT (v); + } + + if (gca == GNUTLS_CIPHER_UNKNOWN) + error ("GnuTLS cipher was invalid or not found"); + + ptrdiff_t 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 %ld was not equal to " + "the required %ld", + gnutls_cipher_get_name (gca), desc, + kend_byte - kstart_byte, (long) gnutls_cipher_get_key_size (gca)); + + ptrdiff_t vstart_byte, vend_byte; + const 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 %ld was not equal to " + "the required %ld", + gnutls_cipher_get_name (gca), desc, + vend_byte - vstart_byte, (long) gnutls_cipher_get_iv_size (gca)); + + 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); + + if (idata == NULL) + error ("GnuTLS cipher input extraction failed"); + + /* Is this an AEAD cipher? */ + if (gnutls_cipher_get_tag_size (gca) > 0) + { + Lisp_Object aead_output = + gnutls_symmetric_aead (encrypting, gca, cipher, + kdata, kend_byte - kstart_byte, + vdata, vend_byte - vstart_byte, + idata, iend_byte - istart_byte, + aead_auth); + if (STRINGP (XCAR (key))) + Fclear_string (XCAR (key)); + return aead_output; + } + + if ((iend_byte - istart_byte) % gnutls_cipher_get_block_size (gca) != 0) + error ("GnuTLS cipher %s/%s input block length %ld was not a multiple " + "of the required %ld", + gnutls_cipher_get_name (gca), desc, + iend_byte - istart_byte, (long) gnutls_cipher_get_block_size (gca)); + + gnutls_cipher_hd_t hcipher; + gnutls_datum_t key_datum = { (unsigned char*) kdata, kend_byte - kstart_byte }; + + 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); + } + + /* Note that this will not support streaming block mode. */ + gnutls_cipher_set_iv (hcipher, (void*) 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; + 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); + + if (STRINGP (XCAR (key))) + Fclear_string (XCAR (key)); + + 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_deinit (hcipher); + + return list2 (storage, actual_iv); +} + +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. + +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 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. + +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) +{ + return gnutls_symmetric (true, cipher, key, iv, input, aead_auth); +} + +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. + +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 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. + +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) +{ + return gnutls_symmetric (false, cipher, key, iv, input, aead_auth); +} + +DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0, + doc: /* Return alist of GnuTLS mac-algorithm method descriptions as plists. + +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) +{ + 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 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. */ + 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); + } + + return mac_algorithms; +} + +DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0, + doc: /* Return alist of GnuTLS digest-algorithm method descriptions as plists. + +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) +{ + 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 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. */ + QCdigest_algorithm_length, + make_number (gnutls_hash_get_len (gda))); + + digest_algorithms = Fcons (mp, digest_algorithms); + } + + return digest_algorithms; +} + +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. + +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'). + +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) +{ + if (BUFFERP (input) || STRINGP (input)) + input = list1 (input); + + CHECK_CONS (input); + + if (BUFFERP (key) || STRINGP (key)) + key = list1 (key); + + CHECK_CONS (key); + + int ret = GNUTLS_E_SUCCESS; + + gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN; + + Lisp_Object info = Qnil; + if (STRINGP (hash_method)) + hash_method = intern (SSDATA (hash_method)); + + if (SYMBOLP (hash_method)) + info = XCDR (Fassq (hash_method, Fgnutls_macs ())); + else if (INTEGERP (hash_method)) + gma = XINT (hash_method); + else + info = hash_method; + + if (!NILP (info) && CONSP (info)) + { + Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); + if (INTEGERP (v)) + gma = XINT (v); + } + + if (gma == GNUTLS_MAC_UNKNOWN) + error ("GnuTLS MAC-method was 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); + + if (kdata == NULL) + error ("GnuTLS MAC key extraction failed"); + + 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); + } + + ptrdiff_t 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); + + if (STRINGP (XCAR (key))) + Fclear_string (XCAR (key)); + + 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_hmac_output (hmac, SSDATA (digest)); + gnutls_hmac_deinit (hmac, NULL); + + return digest; +} + +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. + +The INPUT can be specified as a buffer or string or in other +ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). + +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) +{ + 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; + if (STRINGP (digest_method)) + digest_method = intern (SSDATA (digest_method)); + + if (SYMBOLP (digest_method)) + info = XCDR (Fassq (digest_method, Fgnutls_digests ())); + else if (INTEGERP (digest_method)) + gda = XINT (digest_method); + else + info = digest_method; + + if (!NILP (info) && CONSP (info)) + { + Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); + if (INTEGERP (v)) + gda = XINT (v); + } + + if (gda == GNUTLS_DIG_UNKNOWN) + error ("GnuTLS digest-method was invalid or not found"); + + gnutls_hash_hd_t hash; + 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); + } + + 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); + if (idata == NULL) + error ("GnuTLS digest input extraction failed"); + + ret = gnutls_hash (hash, idata + istart_byte, iend_byte - istart_byte); + + 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); + } + + gnutls_hash_output (hash, SSDATA (digest)); + gnutls_hash_deinit (hash, NULL); + + return digest; +} + +#endif + DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, - doc: /* Return t if GnuTLS is available in this instance of Emacs. */) + 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) { #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 Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); if (CONSP (found)) - return XCDR (found); + return XCDR (found); // TODO: use capabilities. else { Lisp_Object status; - status = init_gnutls_functions () ? Qt : Qnil; + // 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 Qt; + return capabilities; # endif /* !WINDOWSNT */ #else /* !HAVE_GNUTLS */ return Qnil; @@ -1753,6 +2390,27 @@ syms_of_gnutls (void) DEFSYM (QCverify_flags, ":verify-flags"); DEFSYM (QCverify_error, ":verify-error"); + DEFSYM (QCcipher_id, ":cipher-id"); + DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable"); + DEFSYM (QCcipher_blocksize, ":cipher-blocksize"); + DEFSYM (QCcipher_keysize, ":cipher-keysize"); + DEFSYM (QCcipher_tagsize, ":cipher-tagsize"); + DEFSYM (QCcipher_keysize, ":cipher-keysize"); + DEFSYM (QCcipher_ivsize, ":cipher-ivsize"); + + DEFSYM (QCmac_algorithm_id, ":mac-algorithm-id"); + DEFSYM (QCmac_algorithm_noncesize, ":mac-algorithm-noncesize"); + DEFSYM (QCmac_algorithm_keysize, ":mac-algorithm-keysize"); + DEFSYM (QCmac_algorithm_length, ":mac-algorithm-length"); + + DEFSYM (QCdigest_algorithm_id, ":digest-algorithm-id"); + DEFSYM (QCdigest_algorithm_length, ":digest-algorithm-length"); + + DEFSYM (QCtype, ":type"); + DEFSYM (Qgnutls_type_cipher, "gnutls-symmetric-cipher"); + DEFSYM (Qgnutls_type_mac_algorithm, "gnutls-mac-algorithm"); + DEFSYM (Qgnutls_type_digest_algorithm, "gnutls-digest-algorithm"); + DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted"); Fput (Qgnutls_e_interrupted, Qgnutls_code, make_number (GNUTLS_E_INTERRUPTED)); @@ -1780,6 +2438,14 @@ syms_of_gnutls (void) defsubr (&Sgnutls_peer_status); defsubr (&Sgnutls_peer_status_warning_describe); + defsubr (&Sgnutls_ciphers); + defsubr (&Sgnutls_macs); + defsubr (&Sgnutls_digests); + defsubr (&Sgnutls_hash_mac); + defsubr (&Sgnutls_hash_digest); + defsubr (&Sgnutls_symmetric_encrypt); + defsubr (&Sgnutls_symmetric_decrypt); + DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level, doc: /* Logging level used by the GnuTLS functions. Set this larger than 0 to get debug output in the *Messages* buffer. diff --git a/src/gnutls.h b/src/gnutls.h index 3c84023cd4e..981d59410bb 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -23,6 +23,10 @@ along with GNU Emacs. If not, see . */ #include #include +#ifdef HAVE_GNUTLS3 +#include +#endif + #include "lisp.h" /* This limits the attempts to handshake per process (connection). It diff --git a/src/lisp.h b/src/lisp.h index 1e8ef7a449a..a5134a9532c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3386,6 +3386,9 @@ 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); 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, diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el new file mode 100644 index 00000000000..7cef8c1ff10 --- /dev/null +++ b/test/lisp/net/gnutls-tests.el @@ -0,0 +1,290 @@ +;;; gnutls-tests.el --- Test suite for gnutls.el + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Ted Zlatanov + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Run this with `GNUTLS_TEST_VERBOSE=1' to get verbose debugging. + +;;; Code: + +(require 'ert) +(require 'cl) +(require 'gnutls) +(require 'hex-util) + +(defvar gnutls-tests-message-prefix "") + +(defsubst gnutls-tests-message (format-string &rest args) + (when (getenv "GNUTLS_TEST_VERBOSE") + (apply #'message (concat "gnutls-tests: " gnutls-tests-message-prefix format-string) args))) + +;; Minor convenience to see strings more easily (without binary data). +(defsubst gnutls-tests-hexstring-equal (a b) + (and (stringp a) (stringp b) (string-equal (encode-hex-string a) (encode-hex-string b)))) + +(defvar gnutls-tests-internal-macs-upcased + (mapcar (lambda (sym) (cons sym (intern (upcase (symbol-name sym))))) + (secure-hash-algorithms))) + +(defvar gnutls-tests-tested-macs + (remove-duplicates + (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) + (mapcar 'car (gnutls-macs))))) + +(defvar gnutls-tests-tested-digests + (remove-duplicates + (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) + (mapcar 'car (gnutls-digests))))) + +(defvar gnutls-tests-tested-ciphers + (remove-duplicates + ; these cause FPEs or SEGVs + (remove-if (lambda (e) (memq e '(ARCFOUR-128))) + (mapcar 'car (gnutls-ciphers))))) + +(defvar gnutls-tests-mondo-strings + (list + "" + "some data" + "lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data " + "data and more data to go over the block limit!" + "data and more data to go over the block limit" + (format "some random data %d%d" (random) (random)))) + +(ert-deftest test-gnutls-000-availability () + "Test the GnuTLS hashes and ciphers availability." + (skip-unless (memq 'gnutls3 (gnutls-available-p))) + (setq gnutls-tests-message-prefix "availability: ") + (should (> (length gnutls-tests-internal-macs-upcased) 5)) + (let ((macs (gnutls-macs)) + (digests (gnutls-digests)) + (ciphers (gnutls-ciphers))) + (dolist (mac gnutls-tests-tested-macs) + (let ((plist (cdr (assq mac macs)))) + (gnutls-tests-message "MAC %s %S" mac plist) + (dolist (prop '(:mac-algorithm-id :mac-algorithm-length :mac-algorithm-keysize :mac-algorithm-noncesize)) + (should (plist-get plist prop))) + (should (eq 'gnutls-mac-algorithm (plist-get plist :type))))) + (dolist (digest gnutls-tests-tested-digests) + (let ((plist (cdr (assq digest digests)))) + (gnutls-tests-message "digest %s %S" digest plist) + (dolist (prop '(:digest-algorithm-id :digest-algorithm-length)) + (should (plist-get plist prop))) + (should (eq 'gnutls-digest-algorithm (plist-get plist :type))))) + (dolist (cipher gnutls-tests-tested-ciphers) + (let ((plist (cdr (assq cipher ciphers)))) + (gnutls-tests-message "cipher %s %S" cipher plist) + (dolist (prop '(:cipher-id :cipher-blocksize :cipher-keysize :cipher-ivsize)) + (should (plist-get plist prop))) + (should (eq 'gnutls-symmetric-cipher (plist-get plist :type))))))) + +(ert-deftest test-gnutls-000-data-extractions () + "Test the GnuTLS data extractions against the built-in `secure-hash'." + (skip-unless (memq 'digests (gnutls-available-p))) + (setq gnutls-tests-message-prefix "data extraction: ") + (dolist (input gnutls-tests-mondo-strings) + ;; Test buffer extraction + (with-temp-buffer + (insert input) + (insert "not ASCII: не e английски") + (dolist (step '(0 1 2 3 4 5)) + (let ((spec (list (current-buffer) ; a buffer spec + (point-min) + (max (point-min) (- step (point-max))))) + (spec2 (list (buffer-string) ; a string spec + (point-min) + (max (point-min) (- step (point-max)))))) + (should (gnutls-tests-hexstring-equal + (gnutls-hash-digest 'MD5 spec) + (apply 'secure-hash 'md5 (append spec '(t))))) + (should (gnutls-tests-hexstring-equal + (gnutls-hash-digest 'MD5 spec2) + (apply 'secure-hash 'md5 (append spec2 '(t)))))))))) + +(ert-deftest test-gnutls-001-hashes-internal-digests () + "Test the GnuTLS hash digests against the built-in `secure-hash'." + (skip-unless (memq 'digests (gnutls-available-p))) + (setq gnutls-tests-message-prefix "digest internal verification: ") + (let ((macs (gnutls-macs))) + (dolist (mcell gnutls-tests-internal-macs-upcased) + (let ((plist (cdr (assq (cdr mcell) macs)))) + (gnutls-tests-message "Checking digest MAC %S %S" mcell plist) + (dolist (input gnutls-tests-mondo-strings) + ;; Test buffer extraction + (with-temp-buffer + (insert input) + (should (gnutls-tests-hexstring-equal + (gnutls-hash-digest (cdr mcell) (current-buffer)) + (secure-hash (car mcell) (current-buffer) nil nil t)))) + (should (gnutls-tests-hexstring-equal + (gnutls-hash-digest (cdr mcell) input) + (secure-hash (car mcell) input nil nil t)))))))) + +(ert-deftest test-gnutls-002-hashes-digests () + "Test some GnuTLS hash digests against pre-defined outputs." + (skip-unless (memq 'digests (gnutls-available-p))) + (setq gnutls-tests-message-prefix "digest external verification: ") + (let ((macs (gnutls-macs))) + (dolist (test '(("57edf4a22be3c955ac49da2e2107b67a" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" MD5) + ("d174ab98d277d9f5a5611c2c9f419d9f" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" MD5) + ("c3fcd3d76192e4007dfb496cca67e13b" "abcdefghijklmnopqrstuvwxyz" MD5) + ("f96b697d7cb7938d525a2f31aaf161d0" "message digest" MD5) + ("900150983cd24fb0d6963f7d28e17f72" "abc" MD5) + ("0cc175b9c0f1b6a831c399e269772661" "a" MD5) + ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" SHA1) + ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" "SHA1"))) ; check string ID for digest + (destructuring-bind (hash input mac) test + (let ((plist (cdr (assq mac macs))) + result resultb) + (gnutls-tests-message "%s %S" mac plist) + (setq result (encode-hex-string (gnutls-hash-digest mac input))) + (gnutls-tests-message "%S => result %S" test result) + (should (string-equal result hash)) + ;; Test buffer extraction + (with-temp-buffer + (insert input) + (setq resultb (encode-hex-string (gnutls-hash-digest mac (current-buffer)))) + (gnutls-tests-message "%S => result from buffer %S" test resultb) + (should (string-equal resultb hash)))))))) + +(ert-deftest test-gnutls-003-hashes-hmacs () + "Test some predefined GnuTLS HMAC outputs for SHA256." + (skip-unless (memq 'macs (gnutls-available-p))) + (setq gnutls-tests-message-prefix "HMAC verification: ") + (let ((macs (gnutls-macs))) + (dolist (test '(("f5c5021e60d9686fef3bb0414275fe4163bece61d9a95fec7a273746a437b986" "hello\n" "test" SHA256) + ("46b75292b81002fd873e89c532a1b8545d6efc9822ee938feba6de2723161a67" "more and more data goes into a file to exceed the buffer size" "test" SHA256) + ("81568ba71fa2c5f33cc84bf362466988f98eba3735479100b4e8908acad87ac4" "more and more data goes into a file to exceed the buffer size" "very long key goes here to exceed the key size" SHA256) + ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" "SHA256") ; check string ID for HMAC + ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" SHA256))) + (destructuring-bind (hash input key mac) test + (let ((plist (cdr (assq mac macs))) + result) + (gnutls-tests-message "%s %S" mac plist) + (setq result (encode-hex-string (gnutls-hash-mac mac (copy-sequence key) input))) + (gnutls-tests-message "%S => result %S" test result) + (should (string-equal result hash))))))) + + +(defun gnutls-tests-pad-or-trim (s exact) + "Pad or trim string S to EXACT numeric size." + (if (and (consp s) (eq 'iv-auto (nth 0 s))) + s + (let ((e (number-to-string exact))) + (format (concat "%" e "." e "s") s)))) + +(defun gnutls-tests-pad-to-multiple (s blocksize) + "Pad string S to BLOCKSIZE numeric size." + (let* ((e (if (string= s "") + blocksize + (* blocksize (ceiling (length s) blocksize)))) + (out (concat s (make-string (- e (length s)) ? )))) + ;; (gnutls-tests-message "padding %S to length %d for blocksize %d: => %S" s e blocksize out) + out)) + +;; ;;; Testing from the command line: +;; ;;; echo e36a9d13c15a6df23a59a6337d6132b8f7cd5283cb4784b81141b52343a18e5f5e5ee8f5553c23167409dd222478bc30 | perl -lne 'print pack "H*", $_' | openssl enc -aes-128-ctr -d -nosalt -K 6d796b657932 -iv 696e697432 | od -x +(ert-deftest test-gnutls-004-symmetric-ciphers () + "Test the GnuTLS symmetric ciphers" + (skip-unless (memq 'ciphers (gnutls-available-p))) + (setq gnutls-tests-message-prefix "symmetric cipher verification: ") + ;; we expect at least 10 ciphers + (should (> (length (gnutls-ciphers)) 10)) + (let ((keys '("mykey" "mykey2")) + (inputs gnutls-tests-mondo-strings) + (ivs '("" "-abc123-" "init" "ini2")) + (ciphers (remove-if + (lambda (c) (plist-get (cdr (assq c (gnutls-ciphers))) + :cipher-aead-capable)) + gnutls-tests-tested-ciphers))) + + (dolist (cipher ciphers) + (dolist (iv ivs) + (dolist (input inputs) + (dolist (key keys) + (gnutls-tests-message "%S, starting key %S IV %S input %S" (assq cipher (gnutls-ciphers)) key iv input) + (let* ((cplist (cdr (assq cipher (gnutls-ciphers)))) + (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize))) + (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize))) + (iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize))) + (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input)) + (data (nth 0 output)) + (actual-iv (nth 1 output)) + (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data)) + (reverse (nth 0 reverse-output))) + (gnutls-tests-message "%s %S" cipher cplist) + (gnutls-tests-message "key %S IV %S input %S => hexdata %S and reverse %S" key iv input (encode-hex-string data) reverse) + (should-not (gnutls-tests-hexstring-equal input data)) + (should-not (gnutls-tests-hexstring-equal data reverse)) + (should (gnutls-tests-hexstring-equal input reverse))))))))) + +(ert-deftest test-gnutls-005-aead-ciphers () + "Test the GnuTLS AEAD ciphers" + (skip-unless (memq 'AEAD-ciphers (gnutls-available-p))) + (setq gnutls-tests-message-prefix "AEAD verification: ") + (let ((keys '("mykey" "mykey2")) + (inputs gnutls-tests-mondo-strings) + (ivs '("" "-abc123-" "init" "ini2")) + (auths '(nil + "" + "auth data" + "auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data " + "AUTH data and more data to go over the block limit!" + "AUTH data and more data to go over the block limit")) + (ciphers (remove-if + (lambda (c) (or (null (plist-get (cdr (assq c (gnutls-ciphers))) + :cipher-aead-capable)))) + gnutls-tests-tested-ciphers)) + actual-ivlist) + + (dolist (cipher ciphers) + (dolist (input inputs) + (dolist (auth auths) + (dolist (key keys) + (let* ((cplist (cdr (assq cipher (gnutls-ciphers)))) + (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize))) + (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize))) + (ivsize (plist-get cplist :cipher-ivsize))) + (should (>= ivsize 12)) ; as per the RFC + (dolist (iv (append ivs (list (list 'iv-auto ivsize)))) + + (gnutls-tests-message "%S, starting key %S IV %S input %S auth %S" (assq cipher (gnutls-ciphers)) key iv input auth) + (let* ((iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize))) + (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input (copy-sequence auth))) + (data (nth 0 output)) + (actual-iv (nth 1 output)) + (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data auth)) + (reverse (nth 0 reverse-output))) + ;; GNUTLS_RND_NONCE should be good enough to ensure this. + (should-not (member (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist)) + (cond + ((stringp iv) + (should (equal iv actual-iv))) + ((consp iv) + (push (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist) + (gnutls-tests-message "IV list length: %d" (length actual-ivlist)))) + + (gnutls-tests-message "%s %S" cipher cplist) + (gnutls-tests-message "key %S IV %S input %S auth %S => hexdata %S and reverse %S" key iv input auth (encode-hex-string data) reverse) + (should-not (gnutls-tests-hexstring-equal input data)) + (should-not (gnutls-tests-hexstring-equal data reverse)) + (should (gnutls-tests-hexstring-equal input reverse))))))))))) + +(provide 'gnutls-tests) +;;; gnutls-tests.el ends here -- 2.39.2