bug#55719: [PATCH] bindat strz fixes

[Richard Hansen <rhansen@rhansen.org>]

[-- Attachment #1.1.1: Type: text/plain, Size: 2832 bytes --]

Thank you for the review! I have attached a new set of patches.

On 5/31/22 19:00, Stefan Monnier wrote:
>> +(let ((spec (bindat-type :pack-var v
>> +                         (x strz 2 :pack-val v)
>> +                         :unpack-val x)))
> 
> Any particular reason why you define it this way instead of just
> 
>      (bindat-type strz 2)
> 
> ?

Thanks, I should have realized that was possible. Fixed.

>> +  (ert-deftest bindat-test--strz-fixedlen-pack-overflow ()
>> +    :expected-result :failed
>> +    (should (equal (bindat-pack spec "abc") "\141\0")))
> 
> I think this changes the intended semantics.  Until now `strz N` has
> meant that N bytes are used to encode the string and that it can
> hold upto a string of length N (in which case there's no terminating NUL
> byte).  I agree that it's not the only valid semantics, but I'm not sure
> we want to change it at this point.
> 
> Do you have a particular reason to make this change.

A few:
   * The documentation says that the packed output is null terminated
     so that's what users expect.
   * It is safer (packed output is less likely to cause some other
     program to run past the end of the field).
   * Without this change, there is no difference between `strz N` and
     `str N`. So what would be the point of `strz N`?
   * If the user selected strz, the application probably requires null
     termination in all cases, not just when the string is under a
     certain length.

>> +  (ert-deftest bindat-test--strz-fixedlen-unpack ()
>> +    (should (equal (bindat-unpack spec "\0\0") ""))
>> +    (should (equal (bindat-unpack spec "a\0") "a"))))
> 
> How 'bout
> 
>       (bindat-unpack spec "ab")
> 
> ?

I added some comments explaining why cases like that aren't tested.

> (tho I'd write "abc\0" i.s.o "\141\142\143\0").

Done.

> Not sure what we should do about (bindat-unpack spec "abc")?

That is not a valid packed string, so I'm not too concerned about it.
Currently it signals an args-out-of-range error because it tries to
read past the end of the string, which seems like an acceptable
behavior to me. We could make the error message more friendly, such as
"end of input reached while searching for null terminator", but I'd
rather not make that change right now with this set of patches.

>> -     `(cl-incf bindat-idx ,(cond
>> -                            ((null len) `(length ,val))
>> -                            ((numberp len) len)
>> -                            (t `(or ,len (length ,val))))))
>> +     `(cl-incf bindat-idx ,(if (numberp len)
>> +                               len
>> +                             `(1+ (length ,val)))))
> 
> `len` is supposed to be an ELisp *expression*.

Ah, I was wondering why it was written that way. Fixed.

[-- Attachment #1.1.2: 0001-bindat-tests-strz-Add-more-tests.patch --]
[-- Type: text/x-patch, Size: 3535 bytes --]

From e07c58f24608806d81417f70df4d904b4c5fffe3 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sun, 29 May 2022 17:15:04 -0400
Subject: [PATCH 1/7] ; bindat-tests (strz): Add more tests

---
 test/lisp/emacs-lisp/bindat-tests.el | 65 ++++++++++++++++++++++++++++
 1 file changed, 65 insertions(+)

diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index 7722cf6c02..fbe574e490 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -162,4 +162,69 @@ bindat-test--recursive
                                         (bindat-pack bindat-test--LEB128 n))
                          n)))))))
 
+(let ((spec (bindat-type strz 2)))
+  (ert-deftest bindat-test--strz-fixedlen-len ()
+    (should (equal (bindat-length spec "") 2))
+    (should (equal (bindat-length spec "a") 2)))
+
+  (ert-deftest bindat-test--strz-fixedlen-len-overflow ()
+    (should (equal (bindat-length spec "abc") 2)))
+
+  (ert-deftest bindat-test--strz-fixedlen-pack ()
+    (should (equal (bindat-pack spec "") "\0\0"))
+    (should (equal (bindat-pack spec "a") "a\0")))
+
+  (ert-deftest bindat-test--strz-fixedlen-pack-overflow ()
+    :expected-result :failed
+    (should (equal (bindat-pack spec "abc") "a\0")))
+
+  (ert-deftest bindat-test--strz-fixedlen-unpack ()
+    ;; There are no tests for unpacking "ab" or "ab\0" because those
+    ;; packed strings cannot be produced from the spec (packing "ab"
+    ;; should produce "a\0", not "ab" or "ab\0").
+    (should (equal (bindat-unpack spec "\0\0") ""))
+    (should (equal (bindat-unpack spec "a\0") "a"))))
+
+(let ((spec (bindat-type strz)))
+  (ert-deftest bindat-test--strz-varlen-len ()
+    :expected-result :failed
+    (should (equal (bindat-length spec "") 1))
+    (should (equal (bindat-length spec "abc") 4)))
+
+  (ert-deftest bindat-test--strz-varlen-pack ()
+    :expected-result :failed
+    (should (equal (bindat-pack spec "") "\0"))
+    (should (equal (bindat-pack spec "abc") "abc\0")))
+
+  (ert-deftest bindat-test--strz-varlen-unpack ()
+    :expected-result :failed
+    ;; There is no test for unpacking a string without a null
+    ;; terminator because such packed strings cannot be produced from
+    ;; the spec (packing "a" should produce "a\0", not "a").
+    (should (equal (bindat-unpack spec "\0") ""))
+    (should (equal (bindat-unpack spec "abc\0") "abc"))))
+
+(let ((spec '((x strz 2))))
+  (ert-deftest bindat-test--strz-legacy-fixedlen-len ()
+    (should (equal (bindat-length spec '((x . ""))) 2))
+    (should (equal (bindat-length spec '((x . "a"))) 2)))
+
+  (ert-deftest bindat-test--strz-legacy-fixedlen-len-overflow ()
+    (should (equal (bindat-length spec '((x . "abc"))) 2)))
+
+  (ert-deftest bindat-test--strz-legacy-fixedlen-pack ()
+    (should (equal (bindat-pack spec '((x . ""))) "\0\0"))
+    (should (equal (bindat-pack spec '((x . "a"))) "a\0")))
+
+  (ert-deftest bindat-test--strz-legacy-fixedlen-pack-overflow ()
+    :expected-result :failed
+    (should (equal (bindat-pack spec '((x . "abc"))) "a\0")))
+
+  (ert-deftest bindat-test--strz-legacy-fixedlen-unpack ()
+    ;; There are no tests for unpacking "ab" or "ab\0" because those
+    ;; packed strings cannot be produced from the spec (packing "ab"
+    ;; should produce "a\0", not "ab" or "ab\0").
+    (should (equal (bindat-unpack spec "\0\0") '((x . ""))))
+    (should (equal (bindat-unpack spec "a\0") '((x . "a"))))))
+
 ;;; bindat-tests.el ends here
-- 
2.36.1


[-- Attachment #1.1.3: 0002-bindat-strz-Fix-off-by-one-bug-in-computed-length.patch --]
[-- Type: text/x-patch, Size: 1877 bytes --]

From fa1835bd83fc8e64426023fe979079bfa21cbdcb Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sat, 28 May 2022 23:10:44 -0400
Subject: [PATCH 2/7] bindat (strz): Fix off-by-one bug in computed length

* lisp/emacs-lisp/bindat.el (strz): Include null terminator when
computing packed string length.
* test/lisp/emacs-lisp/bindat-tests.el (strz): Mark tests as passing.
---
 lisp/emacs-lisp/bindat.el            | 4 ++--
 test/lisp/emacs-lisp/bindat-tests.el | 2 --
 2 files changed, 2 insertions(+), 4 deletions(-)

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index c6d64975ec..b236e47e5b 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -688,9 +688,9 @@ bindat--type
     ('unpack `(bindat--unpack-strz ,len))
     (`(length ,val)
      `(cl-incf bindat-idx ,(cond
-                            ((null len) `(length ,val))
+                            ((null len) `(1+ (length ,val)))
                             ((numberp len) len)
-                            (t `(or ,len (length ,val))))))
+                            (t `(or ,len (1+ (length ,val)))))))
     (`(pack . ,args)
      (macroexp-let2 nil len len
        `(if ,len
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index fbe574e490..6added9390 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -187,12 +187,10 @@ bindat-test--recursive
 
 (let ((spec (bindat-type strz)))
   (ert-deftest bindat-test--strz-varlen-len ()
-    :expected-result :failed
     (should (equal (bindat-length spec "") 1))
     (should (equal (bindat-length spec "abc") 4)))
 
   (ert-deftest bindat-test--strz-varlen-pack ()
-    :expected-result :failed
     (should (equal (bindat-pack spec "") "\0"))
     (should (equal (bindat-pack spec "abc") "abc\0")))
 
-- 
2.36.1


[-- Attachment #1.1.4: 0003-bindat-strz-Consistent-length-type-check.patch --]
[-- Type: text/x-patch, Size: 1607 bytes --]

From 34dc1a4d39f9c11628b0c9a2bb3c080d6df20983 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sat, 28 May 2022 23:53:51 -0400
Subject: [PATCH 3/7] ; bindat (strz): Consistent length type check

The strz length computation uses `numberp' to switch between
fixed-length and variable-length modes, so packing should too.
---
 lisp/emacs-lisp/bindat.el | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index b236e47e5b..1a7ff625ee 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -693,13 +693,13 @@ bindat--type
                             (t `(or ,len (1+ (length ,val)))))))
     (`(pack . ,args)
      (macroexp-let2 nil len len
-       `(if ,len
-            ;; Same as non-zero terminated strings since we don't actually add
-            ;; the terminating zero anyway (because we rely on the fact that
-            ;; `bindat-raw' was presumably initialized with all-zeroes before
-            ;; we started).
-            (bindat--pack-str ,len . ,args)
-          (bindat--pack-strz . ,args))))))
+       (if (numberp len)
+           ;; Same as non-zero terminated strings since we don't actually add
+           ;; the terminating zero anyway (because we rely on the fact that
+           ;; `bindat-raw' was presumably initialized with all-zeroes before
+           ;; we started).
+           `(bindat--pack-str ,len . ,args)
+         `(bindat--pack-strz . ,args))))))
 
 (cl-defmethod bindat--type (op (_ (eql 'bits))  len)
   (bindat--pcase op
-- 
2.36.1


[-- Attachment #1.1.5: 0004-bindat-strz-Always-write-null-terminator.patch --]
[-- Type: text/x-patch, Size: 2264 bytes --]

From 62af0a06d0e0cc904e8b33b1eed675f68e47892c Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sun, 29 May 2022 17:31:18 -0400
Subject: [PATCH 4/7] bindat (strz): Always write null terminator

* lisp/emacs-lisp/bindat.el (strz): When specifying a fixed length for
a packed strz string, make sure the null terminator is always written
even if the length of the string to pack is greater than or equal to
the fixed length.
* test/lisp/emacs-lisp/bindat-tests.el (strz): Mark test as passing.
---
 lisp/emacs-lisp/bindat.el            | 12 +++++++-----
 test/lisp/emacs-lisp/bindat-tests.el |  1 -
 2 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 1a7ff625ee..68d30e088c 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -694,11 +694,13 @@ bindat--type
     (`(pack . ,args)
      (macroexp-let2 nil len len
        (if (numberp len)
-           ;; Same as non-zero terminated strings since we don't actually add
-           ;; the terminating zero anyway (because we rely on the fact that
-           ;; `bindat-raw' was presumably initialized with all-zeroes before
-           ;; we started).
-           `(bindat--pack-str ,len . ,args)
+           `(progn
+              ;; Same as the str type, except always leave room for the null
+              ;; terminator. This assumes that `len' > 0.
+              (bindat--pack-str ,(1- len) . ,args)
+              ;; "Write" the null terminator. This assumes that `bindat-raw' was
+              ;; initialized with zeroes.
+              (setq bindat-idx (1+ bindat-idx)))
          `(bindat--pack-strz . ,args))))))
 
 (cl-defmethod bindat--type (op (_ (eql 'bits))  len)
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index 6added9390..baf4313170 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -175,7 +175,6 @@ bindat-test--recursive
     (should (equal (bindat-pack spec "a") "a\0")))
 
   (ert-deftest bindat-test--strz-fixedlen-pack-overflow ()
-    :expected-result :failed
     (should (equal (bindat-pack spec "abc") "a\0")))
 
   (ert-deftest bindat-test--strz-fixedlen-unpack ()
-- 
2.36.1


[-- Attachment #1.1.6: 0005-bindat-strz-Fix-wrong-type-argument-error-when-unpac.patch --]
[-- Type: text/x-patch, Size: 1894 bytes --]

From ca088f5fc116542c7e19136eb3546b71200af612 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sun, 29 May 2022 18:09:08 -0400
Subject: [PATCH 5/7] bindat (strz): Fix wrong-type-argument error when
 unpacking

* lisp/emacs-lisp/bindat.el (strz): Fix (wrong-type-argument
number-or-marker-p nil) error when unpacking a strz with
unspecified (variable) length.
* test/lisp/emacs-lisp/bindat-tests.el (strz): Mark test as passing.
---
 lisp/emacs-lisp/bindat.el            | 4 ++--
 test/lisp/emacs-lisp/bindat-tests.el | 1 -
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 68d30e088c..99b896998f 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -165,12 +165,12 @@ bindat--unpack-str
     (if (stringp s) s
       (apply #'unibyte-string s))))
 
-(defun bindat--unpack-strz (len)
+(defun bindat--unpack-strz (&optional len)
   (let ((i 0) s)
     (while (and (if len (< i len) t) (/= (aref bindat-raw (+ bindat-idx i)) 0))
       (setq i (1+ i)))
     (setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
-    (setq bindat-idx (+ bindat-idx len))
+    (setq bindat-idx (+ bindat-idx (or len (1+ i))))
     (if (stringp s) s
       (apply #'unibyte-string s))))
 
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index baf4313170..58c8144ac6 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -194,7 +194,6 @@ bindat-test--recursive
     (should (equal (bindat-pack spec "abc") "abc\0")))
 
   (ert-deftest bindat-test--strz-varlen-unpack ()
-    :expected-result :failed
     ;; There is no test for unpacking a string without a null
     ;; terminator because such packed strings cannot be produced from
     ;; the spec (packing "a" should produce "a\0", not "a").
-- 
2.36.1


[-- Attachment #1.1.7: 0006-bindat-strz-Move-all-pack-logic-to-pack-function.patch --]
[-- Type: text/x-patch, Size: 2315 bytes --]

From 55c5555fae47b52b3881573f005db49f27991236 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sun, 29 May 2022 21:23:57 -0400
Subject: [PATCH 6/7] ; bindat (strz): Move all pack logic to pack function

---
 lisp/emacs-lisp/bindat.el | 30 ++++++++++++++----------------
 1 file changed, 14 insertions(+), 16 deletions(-)

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 99b896998f..b02d19ffba 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -439,11 +439,19 @@ bindat--pack-str
     (aset bindat-raw (+ bindat-idx i) (aref v i)))
   (setq bindat-idx (+ bindat-idx len)))
 
-(defun bindat--pack-strz (v)
-  (let ((len (length v)))
-    (dotimes (i len)
-      (aset bindat-raw (+ bindat-idx i) (aref v i)))
-    (setq bindat-idx (+ bindat-idx len 1))))
+(defun bindat--pack-strz (len v)
+  (if (numberp len)
+      (progn
+        ;; Same as the str type, except always leave room for the null
+        ;; terminator. This assumes that `len' > 0.
+        (bindat--pack-str (1- len) v)
+        ;; "Write" the null terminator. This assumes that `bindat-raw' was
+        ;; initialized with zeroes.
+        (setq bindat-idx (1+ bindat-idx)))
+    (let ((len (length v)))
+      (dotimes (i len)
+        (aset bindat-raw (+ bindat-idx i) (aref v i)))
+      (setq bindat-idx (+ bindat-idx len 1)))))
 
 (defun bindat--pack-bits (len v)
   (let ((bnum (1- (* 8 len))) j m)
@@ -691,17 +699,7 @@ bindat--type
                             ((null len) `(1+ (length ,val)))
                             ((numberp len) len)
                             (t `(or ,len (1+ (length ,val)))))))
-    (`(pack . ,args)
-     (macroexp-let2 nil len len
-       (if (numberp len)
-           `(progn
-              ;; Same as the str type, except always leave room for the null
-              ;; terminator. This assumes that `len' > 0.
-              (bindat--pack-str ,(1- len) . ,args)
-              ;; "Write" the null terminator. This assumes that `bindat-raw' was
-              ;; initialized with zeroes.
-              (setq bindat-idx (1+ bindat-idx)))
-         `(bindat--pack-strz . ,args))))))
+    (`(pack . ,args) `(bindat--pack-strz ,len . ,args))))
 
 (cl-defmethod bindat--type (op (_ (eql 'bits))  len)
   (bindat--pcase op
-- 
2.36.1


[-- Attachment #1.1.8: 0007-bindat-strz-Fix-packing-of-long-strings-with-legacy-.patch --]
[-- Type: text/x-patch, Size: 1694 bytes --]

From b794ae3957bcd7efe54d551a244856c1503d4b03 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sun, 29 May 2022 21:46:16 -0400
Subject: [PATCH 7/7] bindat (strz): Fix packing of long strings with
 legacy-style spec

* lisp/emacs-lisp/bindat.el (strz): Call the proper handler when
packing to fix lack of null terminator when packing strings with
length greater than or equal to the declared length.
* test/lisp/emacs-lisp/bindat-tests.el (strz): Mark test as passing.
---
 lisp/emacs-lisp/bindat.el            | 3 ++-
 test/lisp/emacs-lisp/bindat-tests.el | 1 -
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index b02d19ffba..9ed1ab1065 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -480,7 +480,8 @@ bindat--pack-item
    ('u24r (bindat--pack-u24r v))
    ('u32r (bindat--pack-u32r v))
    ('bits (bindat--pack-bits len v))
-   ((or 'str 'strz) (bindat--pack-str len v))
+   ('str (bindat--pack-str len v))
+   ('strz (bindat--pack-strz len v))
    ('vec
     (let ((l (length v)) (vlen 1))
       (if (consp vectype)
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index 58c8144ac6..df03463475 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -213,7 +213,6 @@ bindat-test--recursive
     (should (equal (bindat-pack spec '((x . "a"))) "a\0")))
 
   (ert-deftest bindat-test--strz-legacy-fixedlen-pack-overflow ()
-    :expected-result :failed
     (should (equal (bindat-pack spec '((x . "abc"))) "a\0")))
 
   (ert-deftest bindat-test--strz-legacy-fixedlen-unpack ()
-- 
2.36.1


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 833 bytes --]