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

[Teodor Zlatanov]

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

    WIP: GnuTLS: add iv-auto capability.1
---
 doc/lispref/text.texi         | 24 +++++++++++++------
 src/fns.c                     | 55 ++++---------------------------------------
 src/gnutls.c                  |  7 ++++--
 test/lisp/net/gnutls-tests.el | 33 +++++++++++++++++++-------
 4 files changed, 51 insertions(+), 68 deletions(-)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index cad6d0f..2ed7369d 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4564,6 +4564,10 @@ the text can't be encoded using the specified or chosen 
coding system.
 When @var{noerror} is address@hidden, this function silently uses
 @code{raw-text} coding instead.
 
address@hidden (@code{iv-auto} @var{length})
+This will generate an IV of the specified length using the GnuTLS
+GNUTLS_RND_NONCE generator.
+
 @end table
 
 @node GnuTLS Cryptographic Functions
@@ -4593,7 +4597,7 @@ ways (@xref{Format of GnuTLS Cryptography Inputs}).
 
 This function returns nil on error, and signals a Lisp error if the
 @var{digest-method} or @var{input} are invalid.  On success, it returns
-a binary string.
+a list of a binary string (the output) and the IV used.
 @end defun
 
 @defun gnutls-macs
@@ -4625,8 +4629,10 @@ The @var{input} can be specified as a buffer or string 
or in other
 ways (@xref{Format of GnuTLS Cryptography Inputs}).
 
 This function returns nil on error, and signals a Lisp error if the
address@hidden or @var{key} or @var{input} are invalid.  On
-success, it returns a binary string.
address@hidden or @var{key} or @var{input} are invalid.
+
+On success, it returns a list of a binary string (the output) and the
+IV used.
 @end defun
 
 @defun gnutls-ciphers
@@ -4660,8 +4666,10 @@ plist has @code{:cipher-aead-capable t}.  Otherwise it's 
ignored.
 
 This function returns nil on error, and signals a Lisp error if the
 @var{cipher} or @var{key}, @var{iv}, or @var{input} are invalid, or if
address@hidden was specified with an AEAD cipher and was invalid.  On
-success, it returns an encrypted binary string.
address@hidden was specified with an AEAD cipher and was invalid.
+
+On success, it returns a list of a binary string (the output) and the
+IV used.
 @end defun
 
 @defun gnutls-symmetric-decrypt cipher key iv input &optional aead_auth
@@ -4683,8 +4691,10 @@ plist has @code{:cipher-aead-capable t}.  Otherwise it's 
ignored.
 This function returns 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 the original string that was
-passed to @code{gnutls-symmetric-encrypt}.
+was invalid.
+
+On success, it returns a list of a binary string (the output) and the
+IV used.
 @end defun
 
 @node Parsing HTML/XML
diff --git a/src/fns.c b/src/fns.c
index 9249c37..6948ee4 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4919,10 +4919,7 @@ extract_data_from_object (Lisp_Object spec,
   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.
+      // Format: (iv-auto REQUIRED-LENGTH)
 
       if (! INTEGERP (start))
         {
@@ -4932,54 +4929,12 @@ extract_data_from_object (Lisp_Object spec,
       else
         {
           /* Make sure the value of "start" doesn't change.  */
-          size_t start_hold = XINT (start);
+          size_t start_hold = XUINT (start);
           object = make_uninit_string (start_hold);
+          gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), 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));
+          *start_byte = 0;
+          *end_byte = start_hold;
         }
 #else
       error ("GnuTLS integration is not available, so 'iv-auto can't be 
used.");
diff --git a/src/gnutls.c b/src/gnutls.c
index 5387075..cd4ed91 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1755,6 +1755,7 @@ gnutls_symmetric_aead (bool encrypting, 
gnutls_cipher_algorithm_t gca,
 
   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 };
@@ -1851,7 +1852,7 @@ gnutls_symmetric_aead (bool encrypting, 
gnutls_cipher_algorithm_t gca,
   Lisp_Object output = make_unibyte_string ((const char *)storage, 
storage_length);
   memset (storage, 0, storage_length);
   SAFE_FREE ();
-  return output;
+  return list2 (output, actual_iv);
 #else
   error ("GnuTLS AEAD cipher %ld was invalid or not found", (long) gca);
   return Qnil;
@@ -1955,6 +1956,8 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher,
       return Qnil;
     }
 
+  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);
 
@@ -2039,7 +2042,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher,
 
   gnutls_cipher_deinit (hcipher);
 
-  return storage;
+  return list2 (storage, actual_iv);
 }
 
 DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, 
Sgnutls_symmetric_encrypt, 4, 5, 0,
diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el
index f0fd25f..a4e7bb7 100644
--- a/test/lisp/net/gnutls-tests.el
+++ b/test/lisp/net/gnutls-tests.el
@@ -184,8 +184,10 @@
 
 (defun gnutls-tests-pad-or-trim (s exact)
   "Pad or trim string S to EXACT numeric size."
-  (let ((e (number-to-string exact)))
-    (format (concat "%" e "." e "s") s)))
+  (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."
@@ -221,8 +223,11 @@
                    (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))
-                   (reverse (gnutls-symmetric-decrypt cplist (copy-sequence 
key) iv data)))
+                   (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))
@@ -245,7 +250,8 @@
         (ciphers (remove-if
                   (lambda (c) (or (null (plist-get (cdr (assq c 
(gnutls-ciphers)))
                                               :cipher-aead-capable))))
-                  gnutls-tests-tested-ciphers)))
+                  gnutls-tests-tested-ciphers))
+        actual-ivlist)
 
     (dolist (cipher ciphers)
       (dolist (input inputs)
@@ -255,13 +261,22 @@
                    (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))))
+              (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)))
-                       (data (gnutls-symmetric-encrypt cplist (copy-sequence 
key) iv input (copy-sequence auth)))
-                       (reverse (gnutls-symmetric-decrypt cplist 
(copy-sequence key) iv data auth)))
+                       (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))
+                  (when (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))