[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/tzz/nettle f47aa43: GnuTLS HMAC and symmetric ciph
|
From: |
Teodor Zlatanov |
|
Subject: |
[Emacs-diffs] scratch/tzz/nettle f47aa43: GnuTLS HMAC and symmetric cipher support with tests |
|
Date: |
Tue, 11 Apr 2017 15:46:24 -0400 (EDT) |
branch: scratch/tzz/nettle
commit f47aa4314aa4946ea79359f113bb5c1d2fcd36bb
Author: Ted Zlatanov <address@hidden>
Commit: Ted Zlatanov <address@hidden>
GnuTLS HMAC and symmetric cipher support with tests
---
configure.ac | 2 +
src/gnutls.c | 581 ++++++++++++++++++++++++++++++++++++++++++
src/gnutls.h | 4 +
test/lisp/net/gnutls-tests.el | 301 ++++++++++++++++++++++
4 files changed, 888 insertions(+)
diff --git a/configure.ac b/configure.ac
index bd8f765..f12472a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -2789,6 +2789,8 @@ 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.])], [])
+ EMACS_CHECK_MODULES([LIBGNUTLS3_AEAD], [gnutls >= 3.4.0],
+ [AC_DEFINE(HAVE_GNUTLS3_AEAD, 1, [Define if using GnuTLS v3 with AEAD
support.])], [])
fi
# Windows loads GnuTLS dynamically
diff --git a/src/gnutls.c b/src/gnutls.c
index 28ab10d..7380ce2 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1696,6 +1696,558 @@ This function may also return `gnutls-e-again', or
#endif /* HAVE_GNUTLS */
+#ifdef HAVE_GNUTLS3
+
+/*
+TODO list:
+doc strings
+additions to the manual and NEWS
+maybe cache gnutls-macs and gnutls-ciphers
+
+EZ> Here and elsewhere, the size of the result is known in advance, so I
+EZ> would avoid allocating a scratch buffer and then copying its data
+EZ> (inside make_unibyte_string) into a newly-allocated string. Instead,
+EZ> use make_uninit_string, and then pass its string data pointer to the
+EZ> algorithm that produces the digest.
+
+*/
+
+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,
+ // The string description of the cipher ID
+ build_unibyte_string (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, Lisp_Object key, Lisp_Object iv,
+ Lisp_Object input, Lisp_Object aead_auth)
+{
+#ifdef HAVE_GNUTLS3_AEAD
+
+ const char* desc = (encrypting ? "encrypt" : "decrypt");
+ Lisp_Object output = Qnil;
+ int ret = GNUTLS_E_SUCCESS;
+
+ gnutls_aead_cipher_hd_t acipher;
+ gnutls_datum_t key_datum = { (unsigned char*) SSDATA (key), SCHARS (key) };
+ 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);
+ return Qnil;
+ }
+
+ size_t storage_length = 512; // GnuTLS self-tests use 384.
+ void *storage = xzalloc (storage_length);
+
+ const char* aead_auth_data = NULL;
+ size_t aead_auth_size = 0;
+
+ if (STRINGP (aead_auth))
+ {
+ aead_auth_data = SSDATA (aead_auth);
+ aead_auth_size = SCHARS (aead_auth);
+ }
+
+ if (encrypting)
+ {
+ ret = gnutls_aead_cipher_encrypt (acipher,
+ SSDATA (iv), SCHARS (iv),
+ aead_auth_data, aead_auth_size,
+ gnutls_cipher_get_tag_size (gca),
+ SSDATA (input), SCHARS (input),
+ storage, &storage_length);
+ }
+ else
+ {
+ ret = gnutls_aead_cipher_decrypt (acipher,
+ SSDATA (iv), SCHARS (iv),
+ aead_auth_data, aead_auth_size,
+ gnutls_cipher_get_tag_size (gca),
+ SSDATA (input), SCHARS (input),
+ storage, &storage_length);
+ }
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ xfree (storage);
+ 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);
+ return Qnil;
+ }
+
+ output = make_unibyte_string (storage, storage_length);
+ xfree (storage);
+
+ gnutls_aead_cipher_deinit (acipher);
+
+ return output;
+#else
+ error ("GnuTLS AEAD cipher %ld was invalid or not found", (long) gca);
+ return Qnil;
+#endif
+}
+
+static Lisp_Object
+gnutls_symmetric (bool encrypting, Lisp_Object cipher,
+ Lisp_Object key, Lisp_Object iv,
+ Lisp_Object input, Lisp_Object aead_auth)
+{
+ CHECK_STRING (input);
+ CHECK_STRING (key);
+ CHECK_STRING (iv);
+
+ const char* desc = (encrypting ? "encrypt" : "decrypt");
+
+ Lisp_Object output = Qnil;
+ int ret = GNUTLS_E_SUCCESS;
+
+ gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN;
+
+ Lisp_Object info = Qnil;
+ if (STRINGP (cipher))
+ {
+ info = XCDR (Fassoc (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");
+ return Qnil;
+ }
+
+ if (SCHARS (key) != 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,
+ SCHARS (key), (long) gnutls_cipher_get_key_size (gca));
+ return Qnil;
+ }
+
+ if (SCHARS (iv) != 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,
+ SCHARS (iv), (long) gnutls_cipher_get_iv_size (gca));
+ return Qnil;
+ }
+
+ if (SCHARS (input) % 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,
+ SCHARS (input), (long) gnutls_cipher_get_block_size (gca));
+ return Qnil;
+ }
+
+ // Is this an AEAD cipher?
+ if (gnutls_cipher_get_tag_size (gca) > 0)
+ {
+ return gnutls_symmetric_aead (encrypting, gca, cipher, key, iv, input,
aead_auth);
+ }
+
+ gnutls_cipher_hd_t hcipher;
+ gnutls_datum_t key_datum = { (unsigned char*) SSDATA (key), SCHARS (key) };
+
+ 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);
+ return Qnil;
+ }
+
+ // TODO: support streaming block mode
+ gnutls_cipher_set_iv (hcipher, SSDATA (iv), SCHARS (iv));
+
+ // GnuTLS docs: "For the supported ciphers the encrypted data length
+ // will equal the plaintext size."
+ size_t storage_length = SCHARS (input);
+ void *storage = xzalloc (storage_length);
+
+ if (encrypting)
+ {
+ ret = gnutls_cipher_encrypt2 (hcipher,
+ SSDATA (input), SCHARS (input),
+ storage, storage_length);
+ }
+ else
+ {
+ ret = gnutls_cipher_decrypt2 (hcipher,
+ SSDATA (input), SCHARS (input),
+ storage, storage_length);
+ }
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ xfree (storage);
+ 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);
+ return Qnil;
+ }
+
+ output = make_unibyte_string (storage, storage_length);
+ xfree (storage);
+ gnutls_cipher_deinit (hcipher);
+
+ return output;
+}
+
+DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt,
Sgnutls_symmetric_encrypt, 4, 5, 0,
+ doc: /* Encrypt INPUT string with symmetric CIPHER and KEY+AEAD_AUTH
and IV strings into a unibyte string.
+
+Returns nil on error. INPUT, KEY, and IV should be unibyte
+strings.
+
+The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. The
+CIPHER may be a string 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 a unibyte string for
+these AEAD ciphers, and it may 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 string with symmetric CIPHER and KEY+AEAD_AUTH
and IV strings into a unibyte string.
+
+Returns nil on error. INPUT, KEY, and IV should be unibyte
+strings. AEAD_AUTH may be a unibyte string or omitted (nil).
+
+The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. The
+CIPHER may be a string 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 a unibyte string for
+these AEAD ciphers, and it may 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,
+ // The string description of the mac-algorithm
ID.
+ build_unibyte_string (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,
+ // The string description of the
digest-algorithm ID.
+ build_unibyte_string (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 string with HASH-METHOD and KEY string into a
unibyte string.
+
+Returns nil on error. INPUT and KEY should be unibyte strings.
+
+The alist of MAC algorithms can be obtained with `gnutls-macs`. The
+HASH-METHOD may be a string 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)
+{
+ CHECK_STRING (input);
+ CHECK_STRING (key);
+
+ Lisp_Object output = Qnil;
+ int ret = GNUTLS_E_SUCCESS;
+
+ gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN;
+
+ Lisp_Object info = Qnil;
+ if (STRINGP (hash_method))
+ {
+ info = XCDR (Fassoc (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");
+ return Qnil;
+ }
+
+ gnutls_hmac_hd_t hmac;
+ ret = gnutls_hmac_init (&hmac, gma, SSDATA (key), SCHARS (key));
+
+ 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);
+ return Qnil;
+ }
+
+ size_t digest_length = gnutls_hmac_get_len (gma);
+ void *digest = xzalloc (digest_length);
+
+ ret = gnutls_hmac (hmac, SSDATA (input), SCHARS (input));
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_hmac_deinit (hmac, digest);
+
+ xfree (digest);
+ const char* str = gnutls_strerror (ret);
+ if (!str)
+ str = "unknown";
+ error ("GnuTLS MAC %s application failed: %s",
+ gnutls_mac_get_name (gma), str);
+ return Qnil;
+ }
+
+ gnutls_hmac_output (hmac, digest);
+ output = make_unibyte_string (digest, digest_length);
+ gnutls_hmac_deinit (hmac, digest);
+
+ xfree (digest);
+ return output;
+}
+
+DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0,
+ doc: /* Digest INPUT string with DIGEST-METHOD into a unibyte string.
+
+Returns nil on error. INPUT should be a unibyte string.
+
+The alist of digest algorithms can be obtained with `gnutls-digests`.
+The DIGEST-METHOD may be a string 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)
+{
+ CHECK_STRING (input);
+
+ Lisp_Object output = Qnil;
+ int ret = GNUTLS_E_SUCCESS;
+
+ gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN;
+
+ Lisp_Object info = Qnil;
+ if (STRINGP (digest_method))
+ {
+ info = XCDR (Fassoc (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");
+ return Qnil;
+ }
+
+ 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);
+ return Qnil;
+ }
+
+ size_t digest_length = gnutls_hash_get_len (gda);
+ void *digest = xzalloc (digest_length);
+
+ ret = gnutls_hash (hash, SSDATA (input), SCHARS (input));
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_hash_deinit (hash, digest);
+
+ xfree (digest);
+ const char* str = gnutls_strerror (ret);
+ if (!str)
+ str = "unknown";
+ error ("GnuTLS digest application failed: %s", str);
+ return Qnil;
+ }
+
+ gnutls_hash_output (hash, digest);
+ output = make_unibyte_string (digest, digest_length);
+ gnutls_hash_deinit (hash, digest);
+
+ xfree (digest);
+ return output;
+}
+
+#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. */)
(void)
@@ -1752,6 +2304,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));
@@ -1779,6 +2352,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 3c84023..981d594 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -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
diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el
new file mode 100644
index 0000000..48c7a7b
--- /dev/null
+++ b/test/lisp/net/gnutls-tests.el
@@ -0,0 +1,301 @@
+;;; gnutls-tests.el --- Test suite for gnutls.el
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <address@hidden>
+
+;; 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-tested-macs
+ (remove-duplicates
+ (append '("MD5" "SHA1" "SHA224" "SHA256" "SHA384" "SHA512")
+ (mapcar 'car (gnutls-macs)))))
+
+(defvar gnutls-tests-tested-digests
+ (remove-duplicates
+ (append '("MD5" "SHA1" "SHA224" "SHA256" "SHA384" "SHA512")
+ (mapcar 'car (gnutls-digests)))))
+
+(defvar gnutls-tests-tested-ciphers
+ (remove-duplicates
+ ; these cause FPEs or SEGVs
+ (remove-if (lambda (e) (member 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 (gnutls-available-p))
+ (setq gnutls-tests-message-prefix "availability: ")
+ (let ((macs (gnutls-macs))
+ (digests (gnutls-digests))
+ (ciphers (gnutls-ciphers)))
+ (dolist (name gnutls-tests-tested-macs)
+ (let ((plist (cdr (assoc name macs))))
+ (gnutls-tests-message "MAC %s %S" name 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 (name gnutls-tests-tested-digests)
+ (let ((plist (cdr (assoc name digests))))
+ (gnutls-tests-message "digest %s %S" name plist)
+ (dolist (prop '(:digest-algorithm-id :digest-algorithm-length))
+ (should (plist-get plist prop)))
+ (should (eq 'gnutls-digest-algorithm (plist-get plist :type)))))
+ (dolist (name gnutls-tests-tested-ciphers)
+ (let ((plist (cdr (assoc name ciphers))))
+ (gnutls-tests-message "cipher %s %S" name 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-001-hashes-digests ()
+ "Test the GnuTLS hash digests against the built-in `secure-hash'."
+ (skip-unless (gnutls-available-p))
+ (setq gnutls-tests-message-prefix "digest internal verification: ")
+ (let ((macs (gnutls-macs)))
+ ;; These are the digest algorithms currently supported by
+ ;; `secure-hash'. Unfortunately this list can't be obtained
+ ;; programmatically.
+ (dolist (sym '(md5 sha1 sha224 sha256 sha384 sha512))
+ (let* ((name (upcase (symbol-name sym)))
+ (plist (cdr (assoc name macs))))
+ (gnutls-tests-message "Checking digest MAC %s %S" name plist)
+ (dolist (input gnutls-tests-mondo-strings)
+ (should (gnutls-tests-hexstring-equal
+ (gnutls-hash-digest name input)
+ (secure-hash sym input nil nil t))))))))
+
+(ert-deftest test-gnutls-002-hashes-digests ()
+ "Test some GnuTLS hash digests against pre-defined outputs."
+ (skip-unless (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")))
+ (destructuring-bind (hash input name) test
+ (let ((plist (cdr (assoc name macs)))
+ result)
+ (gnutls-tests-message "%s %S" name plist)
+ (setq result (encode-hex-string (gnutls-hash-digest name input)))
+ (gnutls-tests-message "%S => result %S" test result)
+ (should (string-equal result hash)))))))
+
+(ert-deftest test-gnutls-003-hashes-hmacs ()
+ "Test some predefined GnuTLS HMAC outputs for SHA256."
+ (skip-unless (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")))
+ (destructuring-bind (hash input key name) test
+ (let ((plist (cdr (assoc name macs)))
+ result)
+ (gnutls-tests-message "%s %S" name plist)
+ (setq result (encode-hex-string (gnutls-hash-mac name 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."
+ (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 (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 (assoc 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" (assoc
cipher (gnutls-ciphers)) key iv input)
+ (let* ((cplist (cdr (assoc 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)))
+ (data (gnutls-symmetric-encrypt cplist key iv input))
+ (reverse (gnutls-symmetric-decrypt cplist key iv data)))
+ (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 (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 (assoc c
(gnutls-ciphers)))
+ :cipher-aead-capable))
+ (member c '("CHACHA20-POLY1305" "AES-128-CCM-8"
"AES-256-CCM-8"))))
+ gnutls-tests-tested-ciphers)))
+
+ (dolist (cipher ciphers)
+ (dolist (iv ivs)
+ (dolist (input inputs)
+ (dolist (auth auths)
+ (dolist (key keys)
+ (gnutls-tests-message "%S, starting key %S IV %S input %S auth
%S" (assoc cipher (gnutls-ciphers)) key iv input auth)
+ (let* ((cplist (cdr (assoc 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)))
+ (data (gnutls-symmetric-encrypt cplist key iv input auth))
+ (reverse (gnutls-symmetric-decrypt cplist key iv data
auth)))
+ (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))))))))))
+
+;; (ert-deftest test-nettle-006-pbkdf2-RFC-6070 ()
+;; "Test the GnuTLS PBKDF2 SHA1 hashing with the RFC 6070 test set"
+;; (should (string-equal (encode-hex-string (nettle-pbkdf2 "pass\000word"
"sa\000lt" 4096 16 "sha1"))
+;; "56fa6aa75548099dcc37d7f03425e0c3"))
+;; (let ((tests
'("0c60c80f961f0e71f3a9b524af6012062fe037a6:password:salt:1:x:sha1"
+;;
"ea6c014dc72d6f8ccd1ed92ace1d41f0d8de8957:password:salt:2:x:sha1"
+;;
"4b007901b765489abead49d926f721d065a429c1:password:salt:4096:x:sha1"
+;; ;;
"eefe3d61cd4da4e4e9945b3d6ba2158c2634e984:password:salt:16777216:x:sha1" ;;
enable for a speed test :)
+;;
"3d2eec4fe41c849b80c8d83662c0e44a8b291a964cf2f07038:passwordPASSWORDpassword:saltSALTsaltSALTsaltSALTsaltSALTsalt:4096:x:sha1"))
+;; test expected)
+;; (while (and tests (setq test (split-string (pop tests) ":")))
+;; (setq expected (pop test))
+;; (setf (nth 2 test) (string-to-number (nth 2 test)))
+;; (setf (nth 3 test) (length (decode-hex-string expected)))
+;; ;; (message "Testing 006-pbkdf2-RFC-6070 %S" test)
+;; (should (string-equal (encode-hex-string (apply 'nettle-pbkdf2
test))
+;; expected)))))
+
+;; (ert-deftest test-nettle-007-rsa-verify ()
+;; "Test the GnuTLS RSA signature verification"
+;; ;; signature too short
+;; (should-error (nettle-rsa-verify "Test the GnuTLS RSA signature"
+;; ""
+;; "Test the GnuTLS RSA signature"
+;; "sha1"))
+
+;; ;; key too short
+;; (should-error (nettle-rsa-verify "Test the GnuTLS RSA signature"
+;; "Test the GnuTLS RSA signature"
+;; ""
+;; "sha1"))
+
+;; ;; invalid hashing method
+;; (should-error (nettle-rsa-verify "Test the GnuTLS RSA signature"
+;; "Test the GnuTLS RSA signature"
+;; ""
+;; "no such method"))
+
+;; ;; key generated with:
+;; ;; openssl genrsa -out privkey.pem 2048
+;; ;; openssl rsa -in privkey.pem -pubout > pubkey.pem
+;; (let* ((key (substring "
+;; -----BEGIN PUBLIC KEY-----
+;; MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAreGA/Qky9W3izQV0kzba
+;; 7wKl/wzwxkbbQxvcUqUT1krgAbO/n1tYFjXdJZoWwbMO/qv7NRoMDY4yPWGpsQfY
+;; +PSIknAhTZVbgwXrm/wb37+hKRKax2UZ9A/Rx4vJZRYlkpvZ9LbBziseFNN7SMWW
+;; qkjBO/NeT8/I9mURDa+4RoYfT6ZwjTvt808PH7uIghk+MHAx9EMBAfafF1Jn9TqW
+;; y+Hgdqik9sZteMvCumvGK4grSwzdfPO5I05tt/0I7QVPxlXbHIk/bBsE7mpgOxur
+;; P0DAkFKtYDM7oZPBwB6X778ba2EEFKPpVIyzw/jlDPd9PB6gE6dixmax3Hlg69RI
+;; EwIDAQAB
+;; -----END PUBLIC KEY-----
+;; " 28 426))
+;; ;; 24 skipped bytes are the header
+;; (key-bitstring (substring (base64-decode-string key) 24)))
+;; ;; invalid signature, valid key
+;; (should-not (nettle-rsa-verify "Test the GnuTLS RSA signature"
+;; "Test the GnuTLS RSA signature"
+;; key-bitstring
+;; "sha1"))
+;; ;; valid signature, valid key
+;; ; doesn't work; generated with "openssl rsautl -sign -in /tmp/test
-inkey /tmp/privkey.pem" but contains other baggage
+;; (should (nettle-rsa-verify "Test the GnuTLS RSA signature"
+;; (decode-hex-string
"abf710d920de0a210167e62995d5cb06fb0ff6a3f81e2f1965dd3f4716883ab61b7dec40d1ebde89b0657473a434d0333177f183f71a9f4b84a49781b1e4bc440e042f2eb4441000ba07168cdb190c5aebba8c433420f6fc28b6997cbfee061170210bfa65294199e6d6c8c5e1a16421942371f6115d77263b859a75645b6b70d56f14ad378c8499318ff05eda9d24a61d854a3d7f6b67b037abb8d25e4b11ca3e42bdb823cfac34c70057ecd55cbb8449346c0824b46f6c668d14f1744bad7d05470953981df32fde24d2a1f27e58bf9e7d99b20b39b25844c539
[...]
+;; key-bitstring
+;; "sha1"))
+;; ))
+
+;; ;; (message (encode-hex-string (nettle-pbkdf2 "password" "salt" 1 20
"sha1")))
+
+(provide 'gnutls-tests)
+;;; gnutls-tests.el ends here