[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 583995c: GnuTLS HMAC and symmetric cipher support
|
From: |
Teodor Zlatanov |
|
Subject: |
[Emacs-diffs] master 583995c: GnuTLS HMAC and symmetric cipher support |
|
Date: |
Fri, 14 Jul 2017 11:07:06 -0400 (EDT) |
branch: master
commit 583995c62dd424775dda33d5134ce04bee2ae685
Author: Ted Zlatanov <address@hidden>
Commit: Ted Zlatanov <address@hidden>
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(-)
diff --git a/configure.ac b/configure.ac
index 980b4c6..525aa51 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 <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
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 9696c73..fd6ddc9 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.
address@hidden secure-hash-algorithms
+This function returns a list of symbols representing algorithms that
address@hidden can use.
address@hidden 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
address@hidden GnuTLS Cryptography
address@hidden GnuTLS Cryptography
address@hidden MD5 checksum
address@hidden SHA hash
address@hidden hash, cryptographic
address@hidden cryptographic hash
address@hidden AEAD cipher
address@hidden cipher, AEAD
address@hidden symmetric cipher
address@hidden 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.
+
address@hidden Format of GnuTLS Cryptography Inputs
address@hidden Format of GnuTLS Cryptography Inputs
address@hidden format of gnutls cryptography inputs
address@hidden 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
address@hidden operate.
+
address@hidden @code
address@hidden @var{buffer}
+Simply passing a buffer as input means the whole buffer should be used.
+
address@hidden @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.
+
address@hidden (@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 address@hidden, this function silently uses
address@hidden coding instead.
+
address@hidden (@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.
+
address@hidden table
+
address@hidden GnuTLS Cryptographic Functions
address@hidden GnuTLS Cryptographic Functions
address@hidden gnutls cryptographic functions
+
address@hidden 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
address@hidden:type gnutls-digest-algorithm} and also will have the key
address@hidden: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.
address@hidden defun
+
address@hidden gnutls-hash-digest digest-method input
+The @var{digest-method} can be the whole plist from
address@hidden, 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.
address@hidden defun
+
address@hidden 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
address@hidden:type gnutls-mac-algorithm} and also will have the keys
address@hidden:mac-algorithm-length} @code{:mac-algorithm-keysize}
address@hidden: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.
address@hidden defun
+
address@hidden gnutls-hash-mac hash-method key input
+The @var{hash-method} can be the whole plist from
address@hidden, 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.
address@hidden defun
+
address@hidden 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
address@hidden:type gnutls-symmetric-cipher} and also will have the keys
address@hidden:cipher-aead-capable} set to @code{nil} or @code{t} to indicate
+AEAD capability; and @code{:cipher-tagsize} @code{:cipher-blocksize}
address@hidden: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.
address@hidden defun
+
address@hidden gnutls-symmetric-encrypt cipher key iv input &optional aead_auth
+The @var{cipher} can be the whole plist from
address@hidden, 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}).
+
address@hidden 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.
address@hidden defun
+
address@hidden gnutls-symmetric-decrypt cipher key iv input &optional aead_auth
+The @var{cipher} can be the whole plist from
address@hidden, 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}).
+
address@hidden 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.
address@hidden defun
+
@node Parsing HTML/XML
@section Parsing HTML and XML
@cindex parsing html
diff --git a/etc/NEWS b/etc/NEWS
index dd6d546..0ab4958 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 f0e10e3..8b7fc0f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -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. */
+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 2078ad8..7a4e92f 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -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.
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/src/lisp.h b/src/lisp.h
index 1e8ef7a..a5134a9 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 0000000..7cef8c1
--- /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 <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-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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 583995c: GnuTLS HMAC and symmetric cipher support,
Teodor Zlatanov <=