aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTed Zlatanov2017-07-14 11:04:19 -0400
committerTed Zlatanov2017-07-14 11:06:16 -0400
commit583995c62dd424775dda33d5134ce04bee2ae685 (patch)
tree732251c7c468b20a70d20578b778946cf49f77fe
parent0f3cc0b8245dfd7a9f6fcc95ec148be03fde8931 (diff)
downloademacs-583995c62dd424775dda33d5134ce04bee2ae685.tar.gz
emacs-583995c62dd424775dda33d5134ce04bee2ae685.zip
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.
-rw-r--r--configure.ac55
-rw-r--r--doc/lispref/text.texi195
-rw-r--r--etc/NEWS14
-rw-r--r--src/fns.c134
-rw-r--r--src/gnutls.c674
-rw-r--r--src/gnutls.h4
-rw-r--r--src/lisp.h3
-rw-r--r--test/lisp/net/gnutls-tests.el290
8 files changed, 1340 insertions, 29 deletions
diff --git a/configure.ac b/configure.ac
index 980b4c633ba..525aa51598a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -2831,6 +2831,61 @@ if test "${with_gnutls}" = "yes" ; then
2831 AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.]) 2831 AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
2832 EMACS_CHECK_MODULES([LIBGNUTLS3], [gnutls >= 3.0.0], 2832 EMACS_CHECK_MODULES([LIBGNUTLS3], [gnutls >= 3.0.0],
2833 [AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.])], []) 2833 [AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.])], [])
2834
2835 AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
2836#include <gnutls/gnutls.h>
2837#include <gnutls/crypto.h>
2838]],
2839[[
2840int main (int argc, char **argv)
2841{
2842 gnutls_hmac_hd_t handle;
2843 gnutls_hmac_deinit(handle, NULL);
2844}
2845]])],
2846 [AC_DEFINE(HAVE_GNUTLS3_HMAC, 1, [Define if using GnuTLS v3 with HMAC support.])])
2847
2848 AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
2849#include <gnutls/gnutls.h>
2850#include <gnutls/crypto.h>
2851]],
2852[[
2853int main (int argc, char **argv)
2854{
2855 gnutls_aead_cipher_hd_t handle;
2856 gnutls_aead_cipher_deinit(handle);
2857}
2858]])],
2859 [AC_DEFINE(HAVE_GNUTLS3_AEAD, 1, [Define if using GnuTLS v3 with AEAD support.])])
2860
2861 AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
2862#include <gnutls/gnutls.h>
2863#include <gnutls/crypto.h>
2864]],
2865[[
2866int main (int argc, char **argv)
2867{
2868 gnutls_cipher_hd_t handle;
2869 gnutls_cipher_encrypt2 (handle,
2870 NULL, 0,
2871 NULL, 0);
2872 gnutls_cipher_deinit(handle);
2873}
2874]])],
2875 [AC_DEFINE(HAVE_GNUTLS3_CIPHER, 1, [Define if using GnuTLS v3 with cipher support.])])
2876
2877 AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
2878#include <gnutls/gnutls.h>
2879#include <gnutls/crypto.h>
2880]],
2881[[
2882int main (int argc, char **argv)
2883{
2884 gnutls_hash_hd_t handle;
2885 gnutls_hash_deinit(handle, NULL);
2886}
2887]])],
2888 [AC_DEFINE(HAVE_GNUTLS3_DIGEST, 1, [Define if using GnuTLS v3 with digest support.])])
2834 fi 2889 fi
2835 2890
2836 # Windows loads GnuTLS dynamically 2891 # Windows loads GnuTLS dynamically
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 9696c73c484..fd6ddc98fed 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -57,6 +57,7 @@ the character after point.
57* Decompression:: Dealing with compressed data. 57* Decompression:: Dealing with compressed data.
58* Base 64:: Conversion to or from base 64 encoding. 58* Base 64:: Conversion to or from base 64 encoding.
59* Checksum/Hash:: Computing cryptographic hashes. 59* Checksum/Hash:: Computing cryptographic hashes.
60* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
60* Parsing HTML/XML:: Parsing HTML and XML. 61* Parsing HTML/XML:: Parsing HTML and XML.
61* Atomic Changes:: Installing several buffer changes atomically. 62* Atomic Changes:: Installing several buffer changes atomically.
62* Change Hooks:: Supplying functions to be run when text is changed. 63* 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
4436security-related applications you should use the other hash types, 4437security-related applications you should use the other hash types,
4437such as SHA-2. 4438such as SHA-2.
4438 4439
4440@defun secure-hash-algorithms
4441This function returns a list of symbols representing algorithms that
4442@code{secure-hash} can use.
4443@end defun
4444
4439@defun secure-hash algorithm object &optional start end binary 4445@defun secure-hash algorithm object &optional start end binary
4440This function returns a hash for @var{object}. The argument 4446This function returns a hash for @var{object}. The argument
4441@var{algorithm} is a symbol stating which hash to compute: one of 4447@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
4494@c according to what we find useful. 4500@c according to what we find useful.
4495@end defun 4501@end defun
4496 4502
4503@node GnuTLS Cryptography
4504@section GnuTLS Cryptography
4505@cindex MD5 checksum
4506@cindex SHA hash
4507@cindex hash, cryptographic
4508@cindex cryptographic hash
4509@cindex AEAD cipher
4510@cindex cipher, AEAD
4511@cindex symmetric cipher
4512@cindex cipher, symmetric
4513
4514If compiled with GnuTLS, Emacs offers built-in cryptographic support.
4515Following the GnuTLS API terminology, the available tools are digests,
4516MACs, symmetric ciphers, and AEAD ciphers.
4517
4518The terms used herein, such as IV (Initialization Vector), require
4519some familiarity with cryptography and will not be defined in detail.
4520Please consult @uref{https://www.gnutls.org/} for specific
4521documentation which may help you understand the terminology and
4522structure of the GnuTLS library.
4523
4524@node Format of GnuTLS Cryptography Inputs
4525@subsection Format of GnuTLS Cryptography Inputs
4526@cindex format of gnutls cryptography inputs
4527@cindex gnutls cryptography inputs format
4528
4529The inputs to GnuTLS cryptographic functions can be specified in
4530several ways, both as primitive Emacs Lisp types or as lists.
4531
4532The list form is currently similar to how @code{md5} and
4533@code{secure-hash} operate.
4534
4535@table @code
4536@item @var{buffer}
4537Simply passing a buffer as input means the whole buffer should be used.
4538
4539@item @var{string}
4540A string as input will be used directly. It may be modified by the
4541function (unlike most other Emacs Lisp functions) to reduce the chance
4542of exposing sensitive data after the function does its work.
4543
4544@item (@var{buffer-or-string} @var{start} @var{end} @var{coding-system} @var{noerror})
4545This specifies a buffer or a string as described above, but an
4546optional range can be specified with @var{start} and @var{end}.
4547
4548In addition an optional @var{coding-system} can be specified if needed.
4549
4550The last optional item, @var{noerror}, overrides the normal error when
4551the text can't be encoded using the specified or chosen coding system.
4552When @var{noerror} is non-@code{nil}, this function silently uses
4553@code{raw-text} coding instead.
4554
4555@item (@code{iv-auto} @var{length})
4556This will generate an IV (Initialization Vector) of the specified
4557length using the GnuTLS @code{GNUTLS_RND_NONCE} generator and pass it
4558to the function. This ensures that the IV is unpredictable and
4559unlikely to be reused in the same session. The actual value of the IV
4560is returned by the function as described below.
4561
4562@end table
4563
4564@node GnuTLS Cryptographic Functions
4565@subsection GnuTLS Cryptographic Functions
4566@cindex gnutls cryptographic functions
4567
4568@defun gnutls-digests
4569This function returns the alist of the GnuTLS digest algorithms.
4570
4571Each entry has a key which represents the algorithm, followed by a
4572plist with internal details about the algorithm. The plist will have
4573@code{:type gnutls-digest-algorithm} and also will have the key
4574@code{:digest-algorithm-length 64} to indicate the size, in bytes, of
4575the resulting digest.
4576
4577There is a name parallel between GnuTLS MAC and digest algorithms but
4578they are separate things internally and should not be mixed.
4579@end defun
4580
4581@defun gnutls-hash-digest digest-method input
4582The @var{digest-method} can be the whole plist from
4583@code{gnutls-digests}, or just the symbol key, or a string with the
4584name of that symbol.
4585
4586The @var{input} can be specified as a buffer or string or in other
4587ways (@pxref{Format of GnuTLS Cryptography Inputs}).
4588
4589This function returns @code{nil} on error, and signals a Lisp error if
4590the @var{digest-method} or @var{input} are invalid. On success, it
4591returns a list of a binary string (the output) and the IV used.
4592@end defun
4593
4594@defun gnutls-macs
4595This function returns the alist of the GnuTLS MAC algorithms.
4596
4597Each entry has a key which represents the algorithm, followed by a
4598plist with internal details about the algorithm. The plist will have
4599@code{:type gnutls-mac-algorithm} and also will have the keys
4600@code{:mac-algorithm-length} @code{:mac-algorithm-keysize}
4601@code{:mac-algorithm-noncesize} to indicate the size, in bytes, of the
4602resulting hash, the key, and the nonce respectively.
4603
4604The nonce is currently unused and only some MACs support it.
4605
4606There is a name parallel between GnuTLS MAC and digest algorithms but
4607they are separate things internally and should not be mixed.
4608@end defun
4609
4610@defun gnutls-hash-mac hash-method key input
4611The @var{hash-method} can be the whole plist from
4612@code{gnutls-macs}, or just the symbol key, or a string with the
4613name of that symbol.
4614
4615The @var{key} can be specified as a buffer or string or in other ways
4616(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be
4617wiped after use if it's a string.
4618
4619The @var{input} can be specified as a buffer or string or in other
4620ways (@pxref{Format of GnuTLS Cryptography Inputs}).
4621
4622This function returns @code{nil} on error, and signals a Lisp error if
4623the @var{hash-method} or @var{key} or @var{input} are invalid.
4624
4625On success, it returns a list of a binary string (the output) and the
4626IV used.
4627@end defun
4628
4629@defun gnutls-ciphers
4630This function returns the alist of the GnuTLS ciphers.
4631
4632Each entry has a key which represents the cipher, followed by a plist
4633with internal details about the algorithm. The plist will have
4634@code{:type gnutls-symmetric-cipher} and also will have the keys
4635@code{:cipher-aead-capable} set to @code{nil} or @code{t} to indicate
4636AEAD capability; and @code{:cipher-tagsize} @code{:cipher-blocksize}
4637@code{:cipher-keysize} @code{:cipher-ivsize} to indicate the size, in
4638bytes, of the tag, block size of the resulting data, the key, and the
4639IV respectively.
4640@end defun
4641
4642@defun gnutls-symmetric-encrypt cipher key iv input &optional aead_auth
4643The @var{cipher} can be the whole plist from
4644@code{gnutls-ciphers}, or just the symbol key, or a string with the
4645name of that symbol.
4646
4647The @var{key} can be specified as a buffer or string or in other ways
4648(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be
4649wiped after use if it's a string.
4650
4651The @var{iv} and @var{input} and the optional @var{aead_auth} can be
4652specified as a buffer or string or in other ways (@pxref{Format of
4653GnuTLS Cryptography Inputs}).
4654
4655@var{aead_auth} is only checked with AEAD ciphers, that is, ciphers whose
4656plist has @code{:cipher-aead-capable t}. Otherwise it's ignored.
4657
4658This function returns @code{nil} on error, and signals a Lisp error if
4659the @var{cipher} or @var{key}, @var{iv}, or @var{input} are invalid,
4660or if @var{aead_auth} was specified with an AEAD cipher and was
4661invalid.
4662
4663On success, it returns a list of a binary string (the output) and the
4664IV used.
4665@end defun
4666
4667@defun gnutls-symmetric-decrypt cipher key iv input &optional aead_auth
4668The @var{cipher} can be the whole plist from
4669@code{gnutls-ciphers}, or just the symbol key, or a string with the
4670name of that symbol.
4671
4672The @var{key} can be specified as a buffer or string or in other ways
4673(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be
4674wiped after use if it's a string.
4675
4676The @var{iv} and @var{input} and the optional @var{aead_auth} can be
4677specified as a buffer or string or in other ways (@pxref{Format of
4678GnuTLS Cryptography Inputs}).
4679
4680@var{aead_auth} is only checked with AEAD ciphers, that is, ciphers whose
4681plist has @code{:cipher-aead-capable t}. Otherwise it's ignored.
4682
4683This function returns @code{nil} on decryption error, and signals a
4684Lisp error if the @var{cipher} or @var{key}, @var{iv}, or @var{input}
4685are invalid, or if @var{aead_auth} was specified with an AEAD cipher
4686and was invalid.
4687
4688On success, it returns a list of a binary string (the output) and the
4689IV used.
4690@end defun
4691
4497@node Parsing HTML/XML 4692@node Parsing HTML/XML
4498@section Parsing HTML and XML 4693@section Parsing HTML and XML
4499@cindex parsing html 4694@cindex parsing html
diff --git a/etc/NEWS b/etc/NEWS
index dd6d5465d85..0ab49587d79 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1114,6 +1114,20 @@ break.
1114** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 1114** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2
1115contain the same elements, regardless of the order. 1115contain the same elements, regardless of the order.
1116 1116
1117** Checksum/Hash
1118
1119+++
1120** New function 'secure-hash-algorithms' to list the algorithms that
1121'secure-hash' supports.
1122See the node "(elisp) Checksum/Hash" in the ELisp manual for details.
1123
1124+++
1125** Emacs now exposes the GnuTLS cryptographic API with the functions
1126'gnutls-macs' and 'gnutls-hash-mac'; 'gnutls-digests' and
1127'gnutls-hash-digest'; 'gnutls-ciphers' and 'gnutls-symmetric-encrypt'
1128and 'gnutls-symmetric-decrypt'.
1129See the node "(elisp) GnuTLS Cryptography" in the ELisp manual for details.
1130
1117+++ 1131+++
1118** Emacs now supports records for user-defined types, via the new 1132** Emacs now supports records for user-defined types, via the new
1119functions 'make-record', 'record', and 'recordp'. Records are now 1133functions 'make-record', 'record', and 'recordp'. Records are now
diff --git a/src/fns.c b/src/fns.c
index f0e10e311f5..8b7fc0f89d8 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -35,12 +35,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
35#include "intervals.h" 35#include "intervals.h"
36#include "window.h" 36#include "window.h"
37#include "puresize.h" 37#include "puresize.h"
38#include "gnutls.h"
38 39
39static void sort_vector_copy (Lisp_Object, ptrdiff_t, 40static void sort_vector_copy (Lisp_Object, ptrdiff_t,
40 Lisp_Object *restrict, Lisp_Object *restrict); 41 Lisp_Object *restrict, Lisp_Object *restrict);
41enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; 42enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
42static bool internal_equal (Lisp_Object, Lisp_Object, 43static bool internal_equal (Lisp_Object, Lisp_Object,
43 enum equal_kind, int, Lisp_Object); 44 enum equal_kind, int, Lisp_Object);
45static Lisp_Object
46secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
47 Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror,
48 Lisp_Object binary);
44 49
45DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, 50DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
46 doc: /* Return the argument unchanged. */ 51 doc: /* Return the argument unchanged. */
@@ -4740,22 +4745,47 @@ make_digest_string (Lisp_Object digest, int digest_size)
4740 return digest; 4745 return digest;
4741} 4746}
4742 4747
4743/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ 4748DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms,
4749 Ssecure_hash_algorithms, 0, 0, 0,
4750 doc: /* Return a list of all the supported `secure_hash' algorithms. */)
4751 (void)
4752{
4753 return listn (CONSTYPE_HEAP, 6,
4754 Qmd5,
4755 Qsha1,
4756 Qsha224,
4757 Qsha256,
4758 Qsha384,
4759 Qsha512);
4760}
4744 4761
4745static Lisp_Object 4762/* Extract data from a string or a buffer. SPEC is a list of
4746secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, 4763(BUFFER-OR-STRING-OR-SYMBOL START END CODING-SYSTEM NOERROR) which behave as
4747 Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, 4764specified with `secure-hash' and in Info node
4748 Lisp_Object binary) 4765`(elisp)Format of GnuTLS Cryptography Inputs'. */
4766const char*
4767extract_data_from_object (Lisp_Object spec,
4768 ptrdiff_t *start_byte,
4769 ptrdiff_t *end_byte)
4749{ 4770{
4750 ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte; 4771 ptrdiff_t size, start_char = 0, end_char = 0;
4751 register EMACS_INT b, e; 4772 register EMACS_INT b, e;
4752 register struct buffer *bp; 4773 register struct buffer *bp;
4753 EMACS_INT temp; 4774 EMACS_INT temp;
4754 int digest_size;
4755 void *(*hash_func) (const char *, size_t, void *);
4756 Lisp_Object digest;
4757 4775
4758 CHECK_SYMBOL (algorithm); 4776 Lisp_Object object = XCAR (spec);
4777
4778 if (! NILP (spec)) spec = XCDR (spec);
4779 Lisp_Object start = (CONSP (spec)) ? XCAR (spec) : Qnil;
4780
4781 if (! NILP (spec)) spec = XCDR (spec);
4782 Lisp_Object end = (CONSP (spec)) ? XCAR (spec) : Qnil;
4783
4784 if (! NILP (spec)) spec = XCDR (spec);
4785 Lisp_Object coding_system = (CONSP (spec)) ? XCAR (spec) : Qnil;
4786
4787 if (! NILP (spec)) spec = XCDR (spec);
4788 Lisp_Object noerror = (CONSP (spec)) ? XCAR (spec) : Qnil;
4759 4789
4760 if (STRINGP (object)) 4790 if (STRINGP (object))
4761 { 4791 {
@@ -4786,12 +4816,12 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
4786 size = SCHARS (object); 4816 size = SCHARS (object);
4787 validate_subarray (object, start, end, size, &start_char, &end_char); 4817 validate_subarray (object, start, end, size, &start_char, &end_char);
4788 4818
4789 start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); 4819 *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char);
4790 end_byte = (end_char == size 4820 *end_byte = (end_char == size
4791 ? SBYTES (object) 4821 ? SBYTES (object)
4792 : string_char_to_byte (object, end_char)); 4822 : string_char_to_byte (object, end_char));
4793 } 4823 }
4794 else 4824 else if (BUFFERP (object))
4795 { 4825 {
4796 struct buffer *prev = current_buffer; 4826 struct buffer *prev = current_buffer;
4797 4827
@@ -4892,10 +4922,56 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
4892 4922
4893 if (STRING_MULTIBYTE (object)) 4923 if (STRING_MULTIBYTE (object))
4894 object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); 4924 object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
4895 start_byte = 0; 4925 *start_byte = 0;
4896 end_byte = SBYTES (object); 4926 *end_byte = SBYTES (object);
4927 }
4928 else if (EQ (object, Qiv_auto))
4929 {
4930#ifdef HAVE_GNUTLS3
4931 // Format: (iv-auto REQUIRED-LENGTH)
4932
4933 if (! INTEGERP (start))
4934 error ("Without a length, iv-auto can't be used. See manual.");
4935 else
4936 {
4937 /* Make sure the value of "start" doesn't change. */
4938 size_t start_hold = XUINT (start);
4939 object = make_uninit_string (start_hold);
4940 gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold);
4941
4942 *start_byte = 0;
4943 *end_byte = start_hold;
4944 }
4945#else
4946 error ("GnuTLS integration is not available, so iv-auto can't be used.");
4947#endif
4897 } 4948 }
4898 4949
4950 return SSDATA (object);
4951}
4952
4953
4954/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
4955
4956static Lisp_Object
4957secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
4958 Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror,
4959 Lisp_Object binary)
4960{
4961 ptrdiff_t start_byte, end_byte;
4962 int digest_size;
4963 void *(*hash_func) (const char *, size_t, void *);
4964 Lisp_Object digest;
4965
4966 CHECK_SYMBOL (algorithm);
4967
4968 Lisp_Object spec = list5 (object, start, end, coding_system, noerror);
4969
4970 const char* input = extract_data_from_object (spec, &start_byte, &end_byte);
4971
4972 if (input == NULL)
4973 error ("secure_hash: failed to extract data from object, aborting!");
4974
4899 if (EQ (algorithm, Qmd5)) 4975 if (EQ (algorithm, Qmd5))
4900 { 4976 {
4901 digest_size = MD5_DIGEST_SIZE; 4977 digest_size = MD5_DIGEST_SIZE;
@@ -4933,7 +5009,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
4933 hexified value */ 5009 hexified value */
4934 digest = make_uninit_string (digest_size * 2); 5010 digest = make_uninit_string (digest_size * 2);
4935 5011
4936 hash_func (SSDATA (object) + start_byte, 5012 hash_func (input + start_byte,
4937 end_byte - start_byte, 5013 end_byte - start_byte,
4938 SSDATA (digest)); 5014 SSDATA (digest));
4939 5015
@@ -4984,6 +5060,8 @@ The two optional arguments START and END are positions specifying for
4984which part of OBJECT to compute the hash. If nil or omitted, uses the 5060which part of OBJECT to compute the hash. If nil or omitted, uses the
4985whole OBJECT. 5061whole OBJECT.
4986 5062
5063The full list of algorithms can be obtained with `secure-hash-algorithms'.
5064
4987If BINARY is non-nil, returns a string in binary form. */) 5065If BINARY is non-nil, returns a string in binary form. */)
4988 (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary) 5066 (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
4989{ 5067{
@@ -5031,13 +5109,6 @@ disregarding any coding systems. If nil, use the current buffer. */ )
5031void 5109void
5032syms_of_fns (void) 5110syms_of_fns (void)
5033{ 5111{
5034 DEFSYM (Qmd5, "md5");
5035 DEFSYM (Qsha1, "sha1");
5036 DEFSYM (Qsha224, "sha224");
5037 DEFSYM (Qsha256, "sha256");
5038 DEFSYM (Qsha384, "sha384");
5039 DEFSYM (Qsha512, "sha512");
5040
5041 /* Hash table stuff. */ 5112 /* Hash table stuff. */
5042 DEFSYM (Qhash_table_p, "hash-table-p"); 5113 DEFSYM (Qhash_table_p, "hash-table-p");
5043 DEFSYM (Qeq, "eq"); 5114 DEFSYM (Qeq, "eq");
@@ -5074,6 +5145,18 @@ syms_of_fns (void)
5074 defsubr (&Smaphash); 5145 defsubr (&Smaphash);
5075 defsubr (&Sdefine_hash_table_test); 5146 defsubr (&Sdefine_hash_table_test);
5076 5147
5148 /* Crypto and hashing stuff. */
5149 DEFSYM (Qiv_auto, "iv-auto");
5150
5151 DEFSYM (Qmd5, "md5");
5152 DEFSYM (Qsha1, "sha1");
5153 DEFSYM (Qsha224, "sha224");
5154 DEFSYM (Qsha256, "sha256");
5155 DEFSYM (Qsha384, "sha384");
5156 DEFSYM (Qsha512, "sha512");
5157
5158 /* Miscellaneous stuff. */
5159
5077 DEFSYM (Qstring_lessp, "string-lessp"); 5160 DEFSYM (Qstring_lessp, "string-lessp");
5078 DEFSYM (Qprovide, "provide"); 5161 DEFSYM (Qprovide, "provide");
5079 DEFSYM (Qrequire, "require"); 5162 DEFSYM (Qrequire, "require");
@@ -5192,6 +5275,7 @@ this variable. */);
5192 defsubr (&Sbase64_encode_string); 5275 defsubr (&Sbase64_encode_string);
5193 defsubr (&Sbase64_decode_string); 5276 defsubr (&Sbase64_decode_string);
5194 defsubr (&Smd5); 5277 defsubr (&Smd5);
5278 defsubr (&Ssecure_hash_algorithms);
5195 defsubr (&Ssecure_hash); 5279 defsubr (&Ssecure_hash);
5196 defsubr (&Sbuffer_hash); 5280 defsubr (&Sbuffer_hash);
5197 defsubr (&Slocale_info); 5281 defsubr (&Slocale_info);
diff --git a/src/gnutls.c b/src/gnutls.c
index 2078ad88f28..7a4e92f0d3f 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
24#include "process.h" 24#include "process.h"
25#include "gnutls.h" 25#include "gnutls.h"
26#include "coding.h" 26#include "coding.h"
27#include "buffer.h"
27 28
28#ifdef HAVE_GNUTLS 29#ifdef HAVE_GNUTLS
29 30
@@ -1697,24 +1698,660 @@ This function may also return `gnutls-e-again', or
1697 1698
1698#endif /* HAVE_GNUTLS */ 1699#endif /* HAVE_GNUTLS */
1699 1700
1701#ifdef HAVE_GNUTLS3
1702
1703DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0,
1704 doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists.
1705The alist key is the cipher name. */)
1706 (void)
1707{
1708 Lisp_Object ciphers = Qnil;
1709
1710 const gnutls_cipher_algorithm_t* gciphers = gnutls_cipher_list ();
1711 for (size_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++)
1712 {
1713 const gnutls_cipher_algorithm_t gca = gciphers[pos];
1714
1715 Lisp_Object cp = listn (CONSTYPE_HEAP, 15,
1716 /* A symbol representing the cipher */
1717 intern (gnutls_cipher_get_name (gca)),
1718 /* The internally meaningful cipher ID */
1719 QCcipher_id,
1720 make_number (gca),
1721 /* The type (vs. other GnuTLS objects). */
1722 QCtype,
1723 Qgnutls_type_cipher,
1724 /* The tag size (nonzero means AEAD). */
1725 QCcipher_aead_capable,
1726 (gnutls_cipher_get_tag_size (gca) == 0) ? Qnil : Qt,
1727 /* The tag size (nonzero means AEAD). */
1728 QCcipher_tagsize,
1729 make_number (gnutls_cipher_get_tag_size (gca)),
1730 /* The block size */
1731 QCcipher_blocksize,
1732 make_number (gnutls_cipher_get_block_size (gca)),
1733 /* The key size */
1734 QCcipher_keysize,
1735 make_number (gnutls_cipher_get_key_size (gca)),
1736 /* IV size */
1737 QCcipher_ivsize,
1738 make_number (gnutls_cipher_get_iv_size (gca)));
1739
1740 ciphers = Fcons (cp, ciphers);
1741 }
1742
1743 return ciphers;
1744}
1745
1746static Lisp_Object
1747gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca,
1748 Lisp_Object cipher,
1749 const char* kdata, size_t ksize,
1750 const char* vdata, size_t vsize,
1751 const char* idata, size_t isize,
1752 Lisp_Object aead_auth)
1753{
1754#ifdef HAVE_GNUTLS3_AEAD
1755
1756 const char* desc = (encrypting ? "encrypt" : "decrypt");
1757 int ret = GNUTLS_E_SUCCESS;
1758 Lisp_Object actual_iv = make_unibyte_string (vdata, vsize);
1759
1760 gnutls_aead_cipher_hd_t acipher;
1761 gnutls_datum_t key_datum = { (unsigned char*) kdata, ksize };
1762 ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum);
1763
1764 if (ret < GNUTLS_E_SUCCESS)
1765 {
1766 const char* str = gnutls_strerror (ret);
1767 if (!str)
1768 str = "unknown";
1769 error ("GnuTLS AEAD cipher %s/%s initialization failed: %s",
1770 gnutls_cipher_get_name (gca), desc, str);
1771 }
1772
1773 size_t storage_length = isize + gnutls_cipher_get_tag_size (gca);
1774 USE_SAFE_ALLOCA;
1775 unsigned char *storage = SAFE_ALLOCA (storage_length);
1776
1777 const char* aead_auth_data = NULL;
1778 size_t aead_auth_size = 0;
1779
1780 if (!NILP (aead_auth))
1781 {
1782 if (BUFFERP (aead_auth) || STRINGP (aead_auth))
1783 aead_auth = list1 (aead_auth);
1784
1785 CHECK_CONS (aead_auth);
1786
1787 ptrdiff_t astart_byte, aend_byte;
1788 const char* adata = extract_data_from_object (aead_auth, &astart_byte, &aend_byte);
1789
1790 if (adata == NULL)
1791 error ("GnuTLS AEAD cipher auth extraction failed");
1792
1793 aead_auth_data = adata;
1794 aead_auth_size = aend_byte - astart_byte;
1795 }
1796
1797 size_t expected_remainder = 0;
1798
1799 if (!encrypting)
1800 expected_remainder = gnutls_cipher_get_tag_size (gca);
1801
1802 if ((isize - expected_remainder) % gnutls_cipher_get_block_size (gca) != 0)
1803 error ("GnuTLS AEAD cipher %s/%s input block length %ld was not a "
1804 "multiple of the required %ld plus the expected tag remainder %ld",
1805 gnutls_cipher_get_name (gca), desc,
1806 (long) isize, (long) gnutls_cipher_get_block_size (gca),
1807 (long) expected_remainder);
1808
1809 if (encrypting)
1810 ret = gnutls_aead_cipher_encrypt (acipher,
1811 vdata, vsize,
1812 aead_auth_data, aead_auth_size,
1813 gnutls_cipher_get_tag_size (gca),
1814 idata, isize,
1815 storage, &storage_length);
1816 else
1817 ret = gnutls_aead_cipher_decrypt (acipher,
1818 vdata, vsize,
1819 aead_auth_data, aead_auth_size,
1820 gnutls_cipher_get_tag_size (gca),
1821 idata, isize,
1822 storage, &storage_length);
1823
1824 if (ret < GNUTLS_E_SUCCESS)
1825 {
1826 memset (storage, 0, storage_length);
1827 SAFE_FREE ();
1828 gnutls_aead_cipher_deinit (acipher);
1829 const char* str = gnutls_strerror (ret);
1830 if (!str)
1831 str = "unknown";
1832 error ("GnuTLS AEAD cipher %s %sion failed: %s",
1833 gnutls_cipher_get_name (gca), desc, str);
1834 }
1835
1836 gnutls_aead_cipher_deinit (acipher);
1837
1838 Lisp_Object output = make_unibyte_string ((const char *)storage, storage_length);
1839 memset (storage, 0, storage_length);
1840 SAFE_FREE ();
1841 return list2 (output, actual_iv);
1842#else
1843 error ("GnuTLS AEAD cipher %ld was invalid or not found", (long) gca);
1844#endif
1845}
1846
1847static Lisp_Object
1848gnutls_symmetric (bool encrypting, Lisp_Object cipher,
1849 Lisp_Object key, Lisp_Object iv,
1850 Lisp_Object input, Lisp_Object aead_auth)
1851{
1852 if (BUFFERP (key) || STRINGP (key))
1853 key = list1 (key);
1854
1855 CHECK_CONS (key);
1856
1857 if (BUFFERP (input) || STRINGP (input))
1858 input = list1 (input);
1859
1860 CHECK_CONS (input);
1861
1862 if (BUFFERP (iv) || STRINGP (iv))
1863 iv = list1 (iv);
1864
1865 CHECK_CONS (iv);
1866
1867
1868 const char* desc = (encrypting ? "encrypt" : "decrypt");
1869
1870 int ret = GNUTLS_E_SUCCESS;
1871
1872 gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN;
1873
1874 Lisp_Object info = Qnil;
1875 if (STRINGP (cipher))
1876 cipher = intern (SSDATA (cipher));
1877
1878 if (SYMBOLP (cipher))
1879 info = XCDR (Fassq (cipher, Fgnutls_ciphers ()));
1880 else if (INTEGERP (cipher))
1881 gca = XINT (cipher);
1882 else
1883 info = cipher;
1884
1885 if (!NILP (info) && CONSP (info))
1886 {
1887 Lisp_Object v = Fplist_get (info, QCcipher_id);
1888 if (INTEGERP (v))
1889 gca = XINT (v);
1890 }
1891
1892 if (gca == GNUTLS_CIPHER_UNKNOWN)
1893 error ("GnuTLS cipher was invalid or not found");
1894
1895 ptrdiff_t kstart_byte, kend_byte;
1896 const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
1897
1898 if (kdata == NULL)
1899 error ("GnuTLS cipher key extraction failed");
1900
1901 if ((kend_byte - kstart_byte) != gnutls_cipher_get_key_size (gca))
1902 error ("GnuTLS cipher %s/%s key length %ld was not equal to "
1903 "the required %ld",
1904 gnutls_cipher_get_name (gca), desc,
1905 kend_byte - kstart_byte, (long) gnutls_cipher_get_key_size (gca));
1906
1907 ptrdiff_t vstart_byte, vend_byte;
1908 const char* vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte);
1909
1910 if (vdata == NULL)
1911 error ("GnuTLS cipher IV extraction failed");
1912
1913 if ((vend_byte - vstart_byte) != gnutls_cipher_get_iv_size (gca))
1914 error ("GnuTLS cipher %s/%s IV length %ld was not equal to "
1915 "the required %ld",
1916 gnutls_cipher_get_name (gca), desc,
1917 vend_byte - vstart_byte, (long) gnutls_cipher_get_iv_size (gca));
1918
1919 Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte);
1920
1921 ptrdiff_t istart_byte, iend_byte;
1922 const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte);
1923
1924 if (idata == NULL)
1925 error ("GnuTLS cipher input extraction failed");
1926
1927 /* Is this an AEAD cipher? */
1928 if (gnutls_cipher_get_tag_size (gca) > 0)
1929 {
1930 Lisp_Object aead_output =
1931 gnutls_symmetric_aead (encrypting, gca, cipher,
1932 kdata, kend_byte - kstart_byte,
1933 vdata, vend_byte - vstart_byte,
1934 idata, iend_byte - istart_byte,
1935 aead_auth);
1936 if (STRINGP (XCAR (key)))
1937 Fclear_string (XCAR (key));
1938 return aead_output;
1939 }
1940
1941 if ((iend_byte - istart_byte) % gnutls_cipher_get_block_size (gca) != 0)
1942 error ("GnuTLS cipher %s/%s input block length %ld was not a multiple "
1943 "of the required %ld",
1944 gnutls_cipher_get_name (gca), desc,
1945 iend_byte - istart_byte, (long) gnutls_cipher_get_block_size (gca));
1946
1947 gnutls_cipher_hd_t hcipher;
1948 gnutls_datum_t key_datum = { (unsigned char*) kdata, kend_byte - kstart_byte };
1949
1950 ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL);
1951
1952 if (ret < GNUTLS_E_SUCCESS)
1953 {
1954 const char* str = gnutls_strerror (ret);
1955 if (!str)
1956 str = "unknown";
1957 error ("GnuTLS cipher %s/%s initialization failed: %s",
1958 gnutls_cipher_get_name (gca), desc, str);
1959 }
1960
1961 /* Note that this will not support streaming block mode. */
1962 gnutls_cipher_set_iv (hcipher, (void*) vdata, vend_byte - vstart_byte);
1963
1964 /*
1965 * GnuTLS docs: "For the supported ciphers the encrypted data length
1966 * will equal the plaintext size."
1967 */
1968 size_t storage_length = iend_byte - istart_byte;
1969 Lisp_Object storage = make_uninit_string (storage_length);
1970
1971 if (encrypting)
1972 ret = gnutls_cipher_encrypt2 (hcipher,
1973 idata, iend_byte - istart_byte,
1974 SSDATA (storage), storage_length);
1975 else
1976 ret = gnutls_cipher_decrypt2 (hcipher,
1977 idata, iend_byte - istart_byte,
1978 SSDATA (storage), storage_length);
1979
1980 if (STRINGP (XCAR (key)))
1981 Fclear_string (XCAR (key));
1982
1983 if (ret < GNUTLS_E_SUCCESS)
1984 {
1985 gnutls_cipher_deinit (hcipher);
1986 const char* str = gnutls_strerror (ret);
1987 if (!str)
1988 str = "unknown";
1989 error ("GnuTLS cipher %s %sion failed: %s",
1990 gnutls_cipher_get_name (gca), desc, str);
1991 }
1992
1993 gnutls_cipher_deinit (hcipher);
1994
1995 return list2 (storage, actual_iv);
1996}
1997
1998DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, Sgnutls_symmetric_encrypt, 4, 5, 0,
1999 doc: /* Encrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string.
2000
2001Returns nil on error.
2002
2003The KEY can be specified as a buffer or string or in other ways
2004(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be
2005wiped after use if it's a string.
2006
2007The IV and INPUT and the optional AEAD_AUTH can be
2008specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
2009
2010The alist of symmetric ciphers can be obtained with `gnutls-ciphers`.
2011The CIPHER may be a string or symbol matching a key in that alist, or
2012a plist with the `:cipher-id' numeric property, or the number itself.
2013
2014AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with
2015:cipher-aead-capable set to t. AEAD_AUTH can be supplied for
2016these AEAD ciphers, but it may still be omitted (nil) as well. */)
2017 (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth)
2018{
2019 return gnutls_symmetric (true, cipher, key, iv, input, aead_auth);
2020}
2021
2022DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt, Sgnutls_symmetric_decrypt, 4, 5, 0,
2023 doc: /* Decrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string.
2024
2025Returns nil on error.
2026
2027The KEY can be specified as a buffer or string or in other ways
2028(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be
2029wiped after use if it's a string.
2030
2031The IV and INPUT and the optional AEAD_AUTH can be
2032specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
2033
2034The alist of symmetric ciphers can be obtained with `gnutls-ciphers`.
2035The CIPHER may be a string or symbol matching a key in that alist, or
2036a plist with the `:cipher-id' numeric property, or the number itself.
2037
2038AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with
2039:cipher-aead-capable set to t. AEAD_AUTH can be supplied for
2040these AEAD ciphers, but it may still be omitted (nil) as well. */)
2041 (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth)
2042{
2043 return gnutls_symmetric (false, cipher, key, iv, input, aead_auth);
2044}
2045
2046DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0,
2047 doc: /* Return alist of GnuTLS mac-algorithm method descriptions as plists.
2048
2049Use the value of the alist (extract it with `alist-get' for instance)
2050with `gnutls-hash-mac'. The alist key is the mac-algorithm method
2051name. */)
2052 (void)
2053{
2054 Lisp_Object mac_algorithms = Qnil;
2055 const gnutls_mac_algorithm_t* macs = gnutls_mac_list ();
2056 for (size_t pos = 0; macs[pos] != 0; pos++)
2057 {
2058 const gnutls_mac_algorithm_t gma = macs[pos];
2059
2060 const char* name = gnutls_mac_get_name (gma);
2061
2062 Lisp_Object mp = listn (CONSTYPE_HEAP, 11,
2063 /* A symbol representing the mac-algorithm. */
2064 intern (name),
2065 /* The internally meaningful mac-algorithm ID. */
2066 QCmac_algorithm_id,
2067 make_number (gma),
2068 /* The type (vs. other GnuTLS objects). */
2069 QCtype,
2070 Qgnutls_type_mac_algorithm,
2071 /* The output length. */
2072 QCmac_algorithm_length,
2073 make_number (gnutls_hmac_get_len (gma)),
2074 /* The key size. */
2075 QCmac_algorithm_keysize,
2076 make_number (gnutls_mac_get_key_size (gma)),
2077 /* The nonce size. */
2078 QCmac_algorithm_noncesize,
2079 make_number (gnutls_mac_get_nonce_size (gma)));
2080 mac_algorithms = Fcons (mp, mac_algorithms);
2081 }
2082
2083 return mac_algorithms;
2084}
2085
2086DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0,
2087 doc: /* Return alist of GnuTLS digest-algorithm method descriptions as plists.
2088
2089Use the value of the alist (extract it with `alist-get' for instance)
2090with `gnutls-hash-digest'. The alist key is the digest-algorithm
2091method name. */)
2092 (void)
2093{
2094 Lisp_Object digest_algorithms = Qnil;
2095 const gnutls_digest_algorithm_t* digests = gnutls_digest_list ();
2096 for (size_t pos = 0; digests[pos] != 0; pos++)
2097 {
2098 const gnutls_digest_algorithm_t gda = digests[pos];
2099
2100 const char* name = gnutls_digest_get_name (gda);
2101
2102 Lisp_Object mp = listn (CONSTYPE_HEAP, 7,
2103 /* A symbol representing the digest-algorithm. */
2104 intern (name),
2105 /* The internally meaningful digest-algorithm ID. */
2106 QCdigest_algorithm_id,
2107 make_number (gda),
2108 QCtype,
2109 Qgnutls_type_digest_algorithm,
2110 /* The digest length. */
2111 QCdigest_algorithm_length,
2112 make_number (gnutls_hash_get_len (gda)));
2113
2114 digest_algorithms = Fcons (mp, digest_algorithms);
2115 }
2116
2117 return digest_algorithms;
2118}
2119
2120DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0,
2121 doc: /* Hash INPUT with HASH-METHOD and KEY into a unibyte string.
2122
2123Returns nil on error.
2124
2125The KEY can be specified as a buffer or string or in other ways
2126(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be
2127wiped after use if it's a string.
2128
2129The INPUT can be specified as a buffer or string or in other
2130ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
2131
2132The alist of MAC algorithms can be obtained with `gnutls-macs`. The
2133HASH-METHOD may be a string or symbol matching a key in that alist, or
2134a plist with the `:mac-algorithm-id' numeric property, or the number
2135itself. */)
2136 (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input)
2137{
2138 if (BUFFERP (input) || STRINGP (input))
2139 input = list1 (input);
2140
2141 CHECK_CONS (input);
2142
2143 if (BUFFERP (key) || STRINGP (key))
2144 key = list1 (key);
2145
2146 CHECK_CONS (key);
2147
2148 int ret = GNUTLS_E_SUCCESS;
2149
2150 gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN;
2151
2152 Lisp_Object info = Qnil;
2153 if (STRINGP (hash_method))
2154 hash_method = intern (SSDATA (hash_method));
2155
2156 if (SYMBOLP (hash_method))
2157 info = XCDR (Fassq (hash_method, Fgnutls_macs ()));
2158 else if (INTEGERP (hash_method))
2159 gma = XINT (hash_method);
2160 else
2161 info = hash_method;
2162
2163 if (!NILP (info) && CONSP (info))
2164 {
2165 Lisp_Object v = Fplist_get (info, QCmac_algorithm_id);
2166 if (INTEGERP (v))
2167 gma = XINT (v);
2168 }
2169
2170 if (gma == GNUTLS_MAC_UNKNOWN)
2171 error ("GnuTLS MAC-method was invalid or not found");
2172
2173 ptrdiff_t kstart_byte, kend_byte;
2174 const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
2175 gnutls_hmac_hd_t hmac;
2176 ret = gnutls_hmac_init (&hmac, gma,
2177 kdata + kstart_byte, kend_byte - kstart_byte);
2178
2179 if (kdata == NULL)
2180 error ("GnuTLS MAC key extraction failed");
2181
2182 if (ret < GNUTLS_E_SUCCESS)
2183 {
2184 const char* str = gnutls_strerror (ret);
2185 if (!str)
2186 str = "unknown";
2187 error ("GnuTLS MAC %s initialization failed: %s",
2188 gnutls_mac_get_name (gma), str);
2189 }
2190
2191 ptrdiff_t istart_byte, iend_byte;
2192 const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte);
2193 if (idata == NULL)
2194 error ("GnuTLS MAC input extraction failed");
2195
2196 size_t digest_length = gnutls_hmac_get_len (gma);
2197 Lisp_Object digest = make_uninit_string (digest_length);
2198
2199 ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte);
2200
2201 if (STRINGP (XCAR (key)))
2202 Fclear_string (XCAR (key));
2203
2204 if (ret < GNUTLS_E_SUCCESS)
2205 {
2206 gnutls_hmac_deinit (hmac, NULL);
2207
2208 const char* str = gnutls_strerror (ret);
2209 if (!str)
2210 str = "unknown";
2211 error ("GnuTLS MAC %s application failed: %s",
2212 gnutls_mac_get_name (gma), str);
2213 }
2214
2215 gnutls_hmac_output (hmac, SSDATA (digest));
2216 gnutls_hmac_deinit (hmac, NULL);
2217
2218 return digest;
2219}
2220
2221DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0,
2222 doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string.
2223
2224Returns nil on error.
2225
2226The INPUT can be specified as a buffer or string or in other
2227ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
2228
2229The alist of digest algorithms can be obtained with `gnutls-digests`.
2230The DIGEST-METHOD may be a string or symbol matching a key in that
2231alist, or a plist with the `:digest-algorithm-id' numeric property, or
2232the number itself. */)
2233 (Lisp_Object digest_method, Lisp_Object input)
2234{
2235 if (BUFFERP (input) || STRINGP (input))
2236 input = list1 (input);
2237
2238 CHECK_CONS (input);
2239
2240 int ret = GNUTLS_E_SUCCESS;
2241
2242 gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN;
2243
2244 Lisp_Object info = Qnil;
2245 if (STRINGP (digest_method))
2246 digest_method = intern (SSDATA (digest_method));
2247
2248 if (SYMBOLP (digest_method))
2249 info = XCDR (Fassq (digest_method, Fgnutls_digests ()));
2250 else if (INTEGERP (digest_method))
2251 gda = XINT (digest_method);
2252 else
2253 info = digest_method;
2254
2255 if (!NILP (info) && CONSP (info))
2256 {
2257 Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id);
2258 if (INTEGERP (v))
2259 gda = XINT (v);
2260 }
2261
2262 if (gda == GNUTLS_DIG_UNKNOWN)
2263 error ("GnuTLS digest-method was invalid or not found");
2264
2265 gnutls_hash_hd_t hash;
2266 ret = gnutls_hash_init (&hash, gda);
2267
2268 if (ret < GNUTLS_E_SUCCESS)
2269 {
2270 const char* str = gnutls_strerror (ret);
2271 if (!str)
2272 str = "unknown";
2273 error ("GnuTLS digest initialization failed: %s", str);
2274 }
2275
2276 size_t digest_length = gnutls_hash_get_len (gda);
2277 Lisp_Object digest = make_uninit_string (digest_length);
2278
2279 ptrdiff_t istart_byte, iend_byte;
2280 const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte);
2281 if (idata == NULL)
2282 error ("GnuTLS digest input extraction failed");
2283
2284 ret = gnutls_hash (hash, idata + istart_byte, iend_byte - istart_byte);
2285
2286 if (ret < GNUTLS_E_SUCCESS)
2287 {
2288 gnutls_hash_deinit (hash, NULL);
2289
2290 const char* str = gnutls_strerror (ret);
2291 if (!str)
2292 str = "unknown";
2293 error ("GnuTLS digest application failed: %s", str);
2294 }
2295
2296 gnutls_hash_output (hash, SSDATA (digest));
2297 gnutls_hash_deinit (hash, NULL);
2298
2299 return digest;
2300}
2301
2302#endif
2303
1700DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, 2304DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
1701 doc: /* Return t if GnuTLS is available in this instance of Emacs. */) 2305 doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs.
2306
2307...if supported : then...
2308GnuTLS 3 or higher : the list will contain 'gnutls3.
2309GnuTLS MACs : the list will contain 'macs.
2310GnuTLS digests : the list will contain 'digests.
2311GnuTLS symmetric ciphers: the list will contain 'ciphers.
2312GnuTLS AEAD ciphers : the list will contain 'AEAD-ciphers. */)
1702 (void) 2313 (void)
1703{ 2314{
1704#ifdef HAVE_GNUTLS 2315#ifdef HAVE_GNUTLS
2316 Lisp_Object capabilities = Qnil;
2317
2318#ifdef HAVE_GNUTLS3
2319
2320 capabilities = Fcons (intern("gnutls3"), capabilities);
2321
2322#ifdef HAVE_GNUTLS3_DIGEST
2323 capabilities = Fcons (intern("digests"), capabilities);
2324#endif
2325
2326#ifdef HAVE_GNUTLS3_CIPHER
2327 capabilities = Fcons (intern("ciphers"), capabilities);
2328
2329#ifdef HAVE_GNUTLS3_AEAD
2330 capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
2331#endif
2332
2333#ifdef HAVE_GNUTLS3_HMAC
2334 capabilities = Fcons (intern("macs"), capabilities);
2335#endif
2336
2337#endif
2338
2339#endif
2340
1705# ifdef WINDOWSNT 2341# ifdef WINDOWSNT
1706 Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); 2342 Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
1707 if (CONSP (found)) 2343 if (CONSP (found))
1708 return XCDR (found); 2344 return XCDR (found); // TODO: use capabilities.
1709 else 2345 else
1710 { 2346 {
1711 Lisp_Object status; 2347 Lisp_Object status;
1712 status = init_gnutls_functions () ? Qt : Qnil; 2348 // TODO: should the capabilities be dynamic here?
2349 status = init_gnutls_functions () ? capabilities : Qnil;
1713 Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); 2350 Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache);
1714 return status; 2351 return status;
1715 } 2352 }
1716# else /* !WINDOWSNT */ 2353# else /* !WINDOWSNT */
1717 return Qt; 2354 return capabilities;
1718# endif /* !WINDOWSNT */ 2355# endif /* !WINDOWSNT */
1719#else /* !HAVE_GNUTLS */ 2356#else /* !HAVE_GNUTLS */
1720 return Qnil; 2357 return Qnil;
@@ -1753,6 +2390,27 @@ syms_of_gnutls (void)
1753 DEFSYM (QCverify_flags, ":verify-flags"); 2390 DEFSYM (QCverify_flags, ":verify-flags");
1754 DEFSYM (QCverify_error, ":verify-error"); 2391 DEFSYM (QCverify_error, ":verify-error");
1755 2392
2393 DEFSYM (QCcipher_id, ":cipher-id");
2394 DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable");
2395 DEFSYM (QCcipher_blocksize, ":cipher-blocksize");
2396 DEFSYM (QCcipher_keysize, ":cipher-keysize");
2397 DEFSYM (QCcipher_tagsize, ":cipher-tagsize");
2398 DEFSYM (QCcipher_keysize, ":cipher-keysize");
2399 DEFSYM (QCcipher_ivsize, ":cipher-ivsize");
2400
2401 DEFSYM (QCmac_algorithm_id, ":mac-algorithm-id");
2402 DEFSYM (QCmac_algorithm_noncesize, ":mac-algorithm-noncesize");
2403 DEFSYM (QCmac_algorithm_keysize, ":mac-algorithm-keysize");
2404 DEFSYM (QCmac_algorithm_length, ":mac-algorithm-length");
2405
2406 DEFSYM (QCdigest_algorithm_id, ":digest-algorithm-id");
2407 DEFSYM (QCdigest_algorithm_length, ":digest-algorithm-length");
2408
2409 DEFSYM (QCtype, ":type");
2410 DEFSYM (Qgnutls_type_cipher, "gnutls-symmetric-cipher");
2411 DEFSYM (Qgnutls_type_mac_algorithm, "gnutls-mac-algorithm");
2412 DEFSYM (Qgnutls_type_digest_algorithm, "gnutls-digest-algorithm");
2413
1756 DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted"); 2414 DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
1757 Fput (Qgnutls_e_interrupted, Qgnutls_code, 2415 Fput (Qgnutls_e_interrupted, Qgnutls_code,
1758 make_number (GNUTLS_E_INTERRUPTED)); 2416 make_number (GNUTLS_E_INTERRUPTED));
@@ -1780,6 +2438,14 @@ syms_of_gnutls (void)
1780 defsubr (&Sgnutls_peer_status); 2438 defsubr (&Sgnutls_peer_status);
1781 defsubr (&Sgnutls_peer_status_warning_describe); 2439 defsubr (&Sgnutls_peer_status_warning_describe);
1782 2440
2441 defsubr (&Sgnutls_ciphers);
2442 defsubr (&Sgnutls_macs);
2443 defsubr (&Sgnutls_digests);
2444 defsubr (&Sgnutls_hash_mac);
2445 defsubr (&Sgnutls_hash_digest);
2446 defsubr (&Sgnutls_symmetric_encrypt);
2447 defsubr (&Sgnutls_symmetric_decrypt);
2448
1783 DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level, 2449 DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
1784 doc: /* Logging level used by the GnuTLS functions. 2450 doc: /* Logging level used by the GnuTLS functions.
1785Set this larger than 0 to get debug output in the *Messages* buffer. 2451Set this larger than 0 to get debug output in the *Messages* buffer.
diff --git a/src/gnutls.h b/src/gnutls.h
index 3c84023cd4e..981d59410bb 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -23,6 +23,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
23#include <gnutls/gnutls.h> 23#include <gnutls/gnutls.h>
24#include <gnutls/x509.h> 24#include <gnutls/x509.h>
25 25
26#ifdef HAVE_GNUTLS3
27#include <gnutls/crypto.h>
28#endif
29
26#include "lisp.h" 30#include "lisp.h"
27 31
28/* This limits the attempts to handshake per process (connection). It 32/* This limits the attempts to handshake per process (connection). It
diff --git a/src/lisp.h b/src/lisp.h
index 1e8ef7a449a..a5134a9532c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3386,6 +3386,9 @@ enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
3386extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; 3386extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
3387extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); 3387extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
3388extern void sweep_weak_hash_tables (void); 3388extern void sweep_weak_hash_tables (void);
3389extern const char* extract_data_from_object (Lisp_Object spec,
3390 ptrdiff_t *start_byte,
3391 ptrdiff_t *end_byte);
3389EMACS_UINT hash_string (char const *, ptrdiff_t); 3392EMACS_UINT hash_string (char const *, ptrdiff_t);
3390EMACS_UINT sxhash (Lisp_Object, int); 3393EMACS_UINT sxhash (Lisp_Object, int);
3391Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, 3394Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float,
diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el
new file mode 100644
index 00000000000..7cef8c1ff10
--- /dev/null
+++ b/test/lisp/net/gnutls-tests.el
@@ -0,0 +1,290 @@
1;;; gnutls-tests.el --- Test suite for gnutls.el
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Ted Zlatanov <tzz@lifelogs.com>
6
7;; This program is free software; you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; This program is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with this program. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; Run this with `GNUTLS_TEST_VERBOSE=1' to get verbose debugging.
23
24;;; Code:
25
26(require 'ert)
27(require 'cl)
28(require 'gnutls)
29(require 'hex-util)
30
31(defvar gnutls-tests-message-prefix "")
32
33(defsubst gnutls-tests-message (format-string &rest args)
34 (when (getenv "GNUTLS_TEST_VERBOSE")
35 (apply #'message (concat "gnutls-tests: " gnutls-tests-message-prefix format-string) args)))
36
37;; Minor convenience to see strings more easily (without binary data).
38(defsubst gnutls-tests-hexstring-equal (a b)
39 (and (stringp a) (stringp b) (string-equal (encode-hex-string a) (encode-hex-string b))))
40
41(defvar gnutls-tests-internal-macs-upcased
42 (mapcar (lambda (sym) (cons sym (intern (upcase (symbol-name sym)))))
43 (secure-hash-algorithms)))
44
45(defvar gnutls-tests-tested-macs
46 (remove-duplicates
47 (append (mapcar 'cdr gnutls-tests-internal-macs-upcased)
48 (mapcar 'car (gnutls-macs)))))
49
50(defvar gnutls-tests-tested-digests
51 (remove-duplicates
52 (append (mapcar 'cdr gnutls-tests-internal-macs-upcased)
53 (mapcar 'car (gnutls-digests)))))
54
55(defvar gnutls-tests-tested-ciphers
56 (remove-duplicates
57 ; these cause FPEs or SEGVs
58 (remove-if (lambda (e) (memq e '(ARCFOUR-128)))
59 (mapcar 'car (gnutls-ciphers)))))
60
61(defvar gnutls-tests-mondo-strings
62 (list
63 ""
64 "some data"
65 "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 "
66 "data and more data to go over the block limit!"
67 "data and more data to go over the block limit"
68 (format "some random data %d%d" (random) (random))))
69
70(ert-deftest test-gnutls-000-availability ()
71 "Test the GnuTLS hashes and ciphers availability."
72 (skip-unless (memq 'gnutls3 (gnutls-available-p)))
73 (setq gnutls-tests-message-prefix "availability: ")
74 (should (> (length gnutls-tests-internal-macs-upcased) 5))
75 (let ((macs (gnutls-macs))
76 (digests (gnutls-digests))
77 (ciphers (gnutls-ciphers)))
78 (dolist (mac gnutls-tests-tested-macs)
79 (let ((plist (cdr (assq mac macs))))
80 (gnutls-tests-message "MAC %s %S" mac plist)
81 (dolist (prop '(:mac-algorithm-id :mac-algorithm-length :mac-algorithm-keysize :mac-algorithm-noncesize))
82 (should (plist-get plist prop)))
83 (should (eq 'gnutls-mac-algorithm (plist-get plist :type)))))
84 (dolist (digest gnutls-tests-tested-digests)
85 (let ((plist (cdr (assq digest digests))))
86 (gnutls-tests-message "digest %s %S" digest plist)
87 (dolist (prop '(:digest-algorithm-id :digest-algorithm-length))
88 (should (plist-get plist prop)))
89 (should (eq 'gnutls-digest-algorithm (plist-get plist :type)))))
90 (dolist (cipher gnutls-tests-tested-ciphers)
91 (let ((plist (cdr (assq cipher ciphers))))
92 (gnutls-tests-message "cipher %s %S" cipher plist)
93 (dolist (prop '(:cipher-id :cipher-blocksize :cipher-keysize :cipher-ivsize))
94 (should (plist-get plist prop)))
95 (should (eq 'gnutls-symmetric-cipher (plist-get plist :type)))))))
96
97(ert-deftest test-gnutls-000-data-extractions ()
98 "Test the GnuTLS data extractions against the built-in `secure-hash'."
99 (skip-unless (memq 'digests (gnutls-available-p)))
100 (setq gnutls-tests-message-prefix "data extraction: ")
101 (dolist (input gnutls-tests-mondo-strings)
102 ;; Test buffer extraction
103 (with-temp-buffer
104 (insert input)
105 (insert "not ASCII: не e английски")
106 (dolist (step '(0 1 2 3 4 5))
107 (let ((spec (list (current-buffer) ; a buffer spec
108 (point-min)
109 (max (point-min) (- step (point-max)))))
110 (spec2 (list (buffer-string) ; a string spec
111 (point-min)
112 (max (point-min) (- step (point-max))))))
113 (should (gnutls-tests-hexstring-equal
114 (gnutls-hash-digest 'MD5 spec)
115 (apply 'secure-hash 'md5 (append spec '(t)))))
116 (should (gnutls-tests-hexstring-equal
117 (gnutls-hash-digest 'MD5 spec2)
118 (apply 'secure-hash 'md5 (append spec2 '(t))))))))))
119
120(ert-deftest test-gnutls-001-hashes-internal-digests ()
121 "Test the GnuTLS hash digests against the built-in `secure-hash'."
122 (skip-unless (memq 'digests (gnutls-available-p)))
123 (setq gnutls-tests-message-prefix "digest internal verification: ")
124 (let ((macs (gnutls-macs)))
125 (dolist (mcell gnutls-tests-internal-macs-upcased)
126 (let ((plist (cdr (assq (cdr mcell) macs))))
127 (gnutls-tests-message "Checking digest MAC %S %S" mcell plist)
128 (dolist (input gnutls-tests-mondo-strings)
129 ;; Test buffer extraction
130 (with-temp-buffer
131 (insert input)
132 (should (gnutls-tests-hexstring-equal
133 (gnutls-hash-digest (cdr mcell) (current-buffer))
134 (secure-hash (car mcell) (current-buffer) nil nil t))))
135 (should (gnutls-tests-hexstring-equal
136 (gnutls-hash-digest (cdr mcell) input)
137 (secure-hash (car mcell) input nil nil t))))))))
138
139(ert-deftest test-gnutls-002-hashes-digests ()
140 "Test some GnuTLS hash digests against pre-defined outputs."
141 (skip-unless (memq 'digests (gnutls-available-p)))
142 (setq gnutls-tests-message-prefix "digest external verification: ")
143 (let ((macs (gnutls-macs)))
144 (dolist (test '(("57edf4a22be3c955ac49da2e2107b67a" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" MD5)
145 ("d174ab98d277d9f5a5611c2c9f419d9f" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" MD5)
146 ("c3fcd3d76192e4007dfb496cca67e13b" "abcdefghijklmnopqrstuvwxyz" MD5)
147 ("f96b697d7cb7938d525a2f31aaf161d0" "message digest" MD5)
148 ("900150983cd24fb0d6963f7d28e17f72" "abc" MD5)
149 ("0cc175b9c0f1b6a831c399e269772661" "a" MD5)
150 ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" SHA1)
151 ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" "SHA1"))) ; check string ID for digest
152 (destructuring-bind (hash input mac) test
153 (let ((plist (cdr (assq mac macs)))
154 result resultb)
155 (gnutls-tests-message "%s %S" mac plist)
156 (setq result (encode-hex-string (gnutls-hash-digest mac input)))
157 (gnutls-tests-message "%S => result %S" test result)
158 (should (string-equal result hash))
159 ;; Test buffer extraction
160 (with-temp-buffer
161 (insert input)
162 (setq resultb (encode-hex-string (gnutls-hash-digest mac (current-buffer))))
163 (gnutls-tests-message "%S => result from buffer %S" test resultb)
164 (should (string-equal resultb hash))))))))
165
166(ert-deftest test-gnutls-003-hashes-hmacs ()
167 "Test some predefined GnuTLS HMAC outputs for SHA256."
168 (skip-unless (memq 'macs (gnutls-available-p)))
169 (setq gnutls-tests-message-prefix "HMAC verification: ")
170 (let ((macs (gnutls-macs)))
171 (dolist (test '(("f5c5021e60d9686fef3bb0414275fe4163bece61d9a95fec7a273746a437b986" "hello\n" "test" SHA256)
172 ("46b75292b81002fd873e89c532a1b8545d6efc9822ee938feba6de2723161a67" "more and more data goes into a file to exceed the buffer size" "test" SHA256)
173 ("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)
174 ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" "SHA256") ; check string ID for HMAC
175 ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" SHA256)))
176 (destructuring-bind (hash input key mac) test
177 (let ((plist (cdr (assq mac macs)))
178 result)
179 (gnutls-tests-message "%s %S" mac plist)
180 (setq result (encode-hex-string (gnutls-hash-mac mac (copy-sequence key) input)))
181 (gnutls-tests-message "%S => result %S" test result)
182 (should (string-equal result hash)))))))
183
184
185(defun gnutls-tests-pad-or-trim (s exact)
186 "Pad or trim string S to EXACT numeric size."
187 (if (and (consp s) (eq 'iv-auto (nth 0 s)))
188 s
189 (let ((e (number-to-string exact)))
190 (format (concat "%" e "." e "s") s))))
191
192(defun gnutls-tests-pad-to-multiple (s blocksize)
193 "Pad string S to BLOCKSIZE numeric size."
194 (let* ((e (if (string= s "")
195 blocksize
196 (* blocksize (ceiling (length s) blocksize))))
197 (out (concat s (make-string (- e (length s)) ? ))))
198 ;; (gnutls-tests-message "padding %S to length %d for blocksize %d: => %S" s e blocksize out)
199 out))
200
201;; ;;; Testing from the command line:
202;; ;;; echo e36a9d13c15a6df23a59a6337d6132b8f7cd5283cb4784b81141b52343a18e5f5e5ee8f5553c23167409dd222478bc30 | perl -lne 'print pack "H*", $_' | openssl enc -aes-128-ctr -d -nosalt -K 6d796b657932 -iv 696e697432 | od -x
203(ert-deftest test-gnutls-004-symmetric-ciphers ()
204 "Test the GnuTLS symmetric ciphers"
205 (skip-unless (memq 'ciphers (gnutls-available-p)))
206 (setq gnutls-tests-message-prefix "symmetric cipher verification: ")
207 ;; we expect at least 10 ciphers
208 (should (> (length (gnutls-ciphers)) 10))
209 (let ((keys '("mykey" "mykey2"))
210 (inputs gnutls-tests-mondo-strings)
211 (ivs '("" "-abc123-" "init" "ini2"))
212 (ciphers (remove-if
213 (lambda (c) (plist-get (cdr (assq c (gnutls-ciphers)))
214 :cipher-aead-capable))
215 gnutls-tests-tested-ciphers)))
216
217 (dolist (cipher ciphers)
218 (dolist (iv ivs)
219 (dolist (input inputs)
220 (dolist (key keys)
221 (gnutls-tests-message "%S, starting key %S IV %S input %S" (assq cipher (gnutls-ciphers)) key iv input)
222 (let* ((cplist (cdr (assq cipher (gnutls-ciphers))))
223 (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize)))
224 (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize)))
225 (iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize)))
226 (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input))
227 (data (nth 0 output))
228 (actual-iv (nth 1 output))
229 (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data))
230 (reverse (nth 0 reverse-output)))
231 (gnutls-tests-message "%s %S" cipher cplist)
232 (gnutls-tests-message "key %S IV %S input %S => hexdata %S and reverse %S" key iv input (encode-hex-string data) reverse)
233 (should-not (gnutls-tests-hexstring-equal input data))
234 (should-not (gnutls-tests-hexstring-equal data reverse))
235 (should (gnutls-tests-hexstring-equal input reverse)))))))))
236
237(ert-deftest test-gnutls-005-aead-ciphers ()
238 "Test the GnuTLS AEAD ciphers"
239 (skip-unless (memq 'AEAD-ciphers (gnutls-available-p)))
240 (setq gnutls-tests-message-prefix "AEAD verification: ")
241 (let ((keys '("mykey" "mykey2"))
242 (inputs gnutls-tests-mondo-strings)
243 (ivs '("" "-abc123-" "init" "ini2"))
244 (auths '(nil
245 ""
246 "auth data"
247 "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 "
248 "AUTH data and more data to go over the block limit!"
249 "AUTH data and more data to go over the block limit"))
250 (ciphers (remove-if
251 (lambda (c) (or (null (plist-get (cdr (assq c (gnutls-ciphers)))
252 :cipher-aead-capable))))
253 gnutls-tests-tested-ciphers))
254 actual-ivlist)
255
256 (dolist (cipher ciphers)
257 (dolist (input inputs)
258 (dolist (auth auths)
259 (dolist (key keys)
260 (let* ((cplist (cdr (assq cipher (gnutls-ciphers))))
261 (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize)))
262 (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize)))
263 (ivsize (plist-get cplist :cipher-ivsize)))
264 (should (>= ivsize 12)) ; as per the RFC
265 (dolist (iv (append ivs (list (list 'iv-auto ivsize))))
266
267 (gnutls-tests-message "%S, starting key %S IV %S input %S auth %S" (assq cipher (gnutls-ciphers)) key iv input auth)
268 (let* ((iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize)))
269 (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input (copy-sequence auth)))
270 (data (nth 0 output))
271 (actual-iv (nth 1 output))
272 (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data auth))
273 (reverse (nth 0 reverse-output)))
274 ;; GNUTLS_RND_NONCE should be good enough to ensure this.
275 (should-not (member (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist))
276 (cond
277 ((stringp iv)
278 (should (equal iv actual-iv)))
279 ((consp iv)
280 (push (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist)
281 (gnutls-tests-message "IV list length: %d" (length actual-ivlist))))
282
283 (gnutls-tests-message "%s %S" cipher cplist)
284 (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)
285 (should-not (gnutls-tests-hexstring-equal input data))
286 (should-not (gnutls-tests-hexstring-equal data reverse))
287 (should (gnutls-tests-hexstring-equal input reverse)))))))))))
288
289(provide 'gnutls-tests)
290;;; gnutls-tests.el ends here