procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

GnuTLS HMAC and symmetric cipher support

Browse source 
* 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.
This commit is contained in:
Ted Zlatanov 2017-07-14 11:04:19 -04:00
parent 0f3cc0b824
commit 583995c62d
No known key found for this signature in database
GPG key ID: 11F23D0A4E4B9DEE
8 changed files with 1341 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
configure.ac
View file

@ -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 <gnutls/gnutls.h>
#include <gnutls/crypto.h>
]],
[[
int main (int argc, char **argv)
{
gnutls_hmac_hd_t handle;
gnutls_hmac_deinit(handle, NULL);
}
]])],
[AC_DEFINE(HAVE_GNUTLS3_HMAC, 1, [Define if using GnuTLS v3 with HMAC support.])])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#include <gnutls/gnutls.h>
#include <gnutls/crypto.h>
]],
[[
int main (int argc, char **argv)
{
gnutls_aead_cipher_hd_t handle;
gnutls_aead_cipher_deinit(handle);
}
]])],
[AC_DEFINE(HAVE_GNUTLS3_AEAD, 1, [Define if using GnuTLS v3 with AEAD support.])])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#include <gnutls/gnutls.h>
#include <gnutls/crypto.h>
]],
[[
int main (int argc, char **argv)
{
gnutls_cipher_hd_t handle;
gnutls_cipher_encrypt2 (handle,
NULL, 0,
NULL, 0);
gnutls_cipher_deinit(handle);
}
]])],
[AC_DEFINE(HAVE_GNUTLS3_CIPHER, 1, [Define if using GnuTLS v3 with cipher support.])])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#include <gnutls/gnutls.h>
#include <gnutls/crypto.h>
]],
[[
int main (int argc, char **argv)
{
gnutls_hash_hd_t handle;
gnutls_hash_deinit(handle, NULL);
}
]])],
[AC_DEFINE(HAVE_GNUTLS3_DIGEST, 1, [Define if using GnuTLS v3 with digest support.])])
fi
# Windows loads GnuTLS dynamically

195
doc/lispref/text.texi
View file

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

14
etc/NEWS
View file

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

136
src/fns.c
View file

@ -35,12 +35,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#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. */
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 ("secure-hash-algorithms", Fsecure_hash_algorithms,
Ssecure_hash_algorithms, 0, 0, 0,
doc: /* Return a list of all the supported `secure_hash' algorithms. */)
(void)
{
ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte;
return listn (CONSTYPE_HEAP, 6,
Qmd5,
Qsha1,
Qsha224,
Qsha256,
Qsha384,
Qsha512);
}
/* 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, 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,9 +4922,55 @@ 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))
{
@ -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);

674
src/gnutls.c
View file

@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#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.

4
src/gnutls.h
View file

@ -23,6 +23,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <gnutls/gnutls.h>
#include <gnutls/x509.h>
#ifdef HAVE_GNUTLS3
#include <gnutls/crypto.h>
#endif
#include "lisp.h"
/* This limits the attempts to handshake per process (connection). It

3
src/lisp.h
View file

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

290
test/lisp/net/gnutls-tests.el Normal file
View file

@ -0,0 +1,290 @@
;;; gnutls-tests.el --- Test suite for gnutls.el
;; Copyright (C) 2017 Free Software Foundation, Inc.
;; Author: Ted Zlatanov <tzz@lifelogs.com>
;; 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 <http://www.gnu.org/licenses/>.
;;; 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