[Emacs-diffs] scratch/tzz/nettle fdb58cc: WIP: GnuTLS: add iv-auto capability

[Teodor Zlatanov]

branch: scratch/tzz/nettle
commit fdb58ccb0745ca225ed230db24074e7bb7a5aae2
Author: Ted Zlatanov <address@hidden>
Commit: Ted Zlatanov <address@hidden>

    WIP: GnuTLS: add iv-auto capability
---
 src/fns.c                     | 108 ++++++++++++++++++++++++++++++++++++++----
 test/lisp/net/gnutls-tests.el |  35 +++++++-------
 2 files changed, 117 insertions(+), 26 deletions(-)

diff --git a/src/fns.c b/src/fns.c
index b351c7c..9249c37 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.  */
@@ -4749,9 +4754,14 @@ DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms,
                 Qsha512);
 }
 
+/* Hashtable of IVs already generated.  */
+
+static Lisp_Object iv_auto_hashtable;
+
 /* Extract data from a string or a buffer. SPEC is a list of
-(BUFFER-OR-STRING START END CODING-SYSTEM NOERROR) which behave as
-specified with `secure-hash'.  */
+(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,
@@ -4802,7 +4812,7 @@ extract_data_from_object (Lisp_Object spec,
                    ? SBYTES (object)
                    : string_char_to_byte (object, end_char));
     }
-  else
+  else if (BUFFERP (object))
     {
       struct buffer *prev = current_buffer;
 
@@ -4906,6 +4916,76 @@ extract_data_from_object (Lisp_Object spec,
       *start_byte = 0;
       *end_byte = SBYTES (object);
     }
+  else if (EQ (object, Qiv_auto))
+    {
+#ifdef HAVE_GNUTLS3
+      // Format: (iv-auto LENGTH KEY)
+      // Following https://tools.ietf.org/html/rfc5116#section-3.1 to
+      // implement a fixed + variable (counter) nonce generator. If
+      // the key is not given, we use gnutls_rnd with GNUTLS_RND_NONCE.
+
+      if (! INTEGERP (start))
+        {
+          error ("Without a length, 'iv-auto can't be used. See manual.");
+          object = Qnil;
+        }
+      else
+        {
+          /* Make sure the value of "start" doesn't change.  */
+          size_t start_hold = XINT (start);
+          object = make_uninit_string (start_hold);
+
+          int length_of_key_hash = 8;
+          Lisp_Object key_hash = Qnil;
+          // If the key was passed to us, use it to form the nonce.
+          if (! NILP (end))
+            {
+              Lisp_Object key_spec = list5 (end, Qnil, Qnil, Qnil, Qt);
+              ptrdiff_t start_key_byte, end_key_byte;
+              const char* key_input = extract_data_from_object (key_spec,
+                                                                
&start_key_byte,
+                                                                &end_key_byte);
+
+              if (key_input != NULL)
+                {
+                  // This will produce more than length_of_key_hash
+                  // bytes, but we'll use just length_of_key_hash.
+                  Lisp_Object k = make_string (key_input, end_key_byte - 
start_key_byte);
+                  Lisp_Object full = secure_hash (Qsha384, k,
+                                                  Qnil, Qnil, Qnil, Qt, Qt);
+                  key_hash = make_string (SSDATA (full), length_of_key_hash);
+                }
+            }
+
+          // For any reason we don't have a key: make one with 
GNUTLS_RND_NONCE.
+          if (NILP (key_hash))
+            {
+              key_hash = make_uninit_string (length_of_key_hash);
+              gnutls_rnd (GNUTLS_RND_NONCE,
+                          SSDATA (key_hash),
+                          length_of_key_hash);
+            }
+
+          uint64_t counter_value = 0;
+          Lisp_Object counter = call3 (intern ("gethash"), key_hash, 
iv_auto_hashtable,
+                                       make_number (counter_value));
+          if (INTEGERP (counter))
+            {
+              counter_value = XUINT (counter);
+              counter_value++;
+              counter = make_number (counter_value);
+            }
+
+          call3 (intern ("puthash"), key_hash, counter, iv_auto_hashtable);
+          memcpy (SSDATA (key_hash), SSDATA (object), length_of_key_hash);
+          memcpy (SSDATA (counter), SSDATA (object) + length_of_key_hash,
+                  min (start_hold - length_of_key_hash, 4));
+        }
+#else
+      error ("GnuTLS integration is not available, so 'iv-auto can't be 
used.");
+      object = Qnil;
+#endif
+    }
 
   return SSDATA (object);
 }
@@ -5069,13 +5149,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");
@@ -5112,6 +5185,21 @@ syms_of_fns (void)
   defsubr (&Smaphash);
   defsubr (&Sdefine_hash_table_test);
 
+  /* Crypto and hashing stuff.  */
+  DEFSYM (Qiv_auto, "iv-auto");
+
+  iv_auto_hashtable = CALLN (Fmake_hash_table, QCtest, Qequal, QCsize, 
make_number (100));
+  staticpro (&iv_auto_hashtable);
+
+  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");
diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el
index 7b1c2d0..f0fd25f 100644
--- a/test/lisp/net/gnutls-tests.el
+++ b/test/lisp/net/gnutls-tests.el
@@ -248,22 +248,25 @@
                   gnutls-tests-tested-ciphers)))
 
     (dolist (cipher ciphers)
-      (dolist (iv ivs)
-        (dolist (input inputs)
-          (dolist (auth auths)
-            (dolist (key keys)
-              (gnutls-tests-message "%S, starting key %S IV %S input %S auth 
%S" (assq cipher (gnutls-ciphers)) key iv input auth)
-              (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)))
-                     (data (gnutls-symmetric-encrypt cplist (copy-sequence 
key) iv input (copy-sequence auth)))
-                     (reverse (gnutls-symmetric-decrypt cplist (copy-sequence 
key) iv data auth)))
-                (gnutls-tests-message "%s %S" cipher cplist)
-                (gnutls-tests-message "key %S IV %S input %S auth %S => 
hexdata %S and reverse %S" key iv input auth (encode-hex-string data) reverse)
-                (should-not (gnutls-tests-hexstring-equal input data))
-                (should-not (gnutls-tests-hexstring-equal data reverse))
-                (should (gnutls-tests-hexstring-equal input reverse))))))))))
+      (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)))
+              (dolist (iv (append ivs (list (list 'iv-auto ivsize key)
+                                            (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)))
+                       (data (gnutls-symmetric-encrypt cplist (copy-sequence 
key) iv input (copy-sequence auth)))
+                       (reverse (gnutls-symmetric-decrypt cplist 
(copy-sequence key) iv data auth)))
+                  (gnutls-tests-message "%s %S" cipher cplist)
+                  (gnutls-tests-message "key %S IV %S input %S auth %S => 
hexdata %S and reverse %S" key iv input auth (encode-hex-string data) reverse)
+                  (should-not (gnutls-tests-hexstring-equal input data))
+                  (should-not (gnutls-tests-hexstring-equal data reverse))
+                  (should (gnutls-tests-hexstring-equal input 
reverse)))))))))))
 
 (provide 'gnutls-tests)
 ;;; gnutls-tests.el ends here