bug#55719: [PATCH] bindat strz fixes

[Richard Hansen <rhansen@rhansen.org>]

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

The attached series of patches should fix bug #55719 (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=55719).

I have already signed the copyright assignment agreement.

Thanks,
Richard

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

From 92223dc60acc6531ac86bfcee1eebc38f8304841 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 | 60 ++++++++++++++++++++++++++++
 1 file changed, 60 insertions(+)

diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index 7722cf6c02..53c0c359d8 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -162,4 +162,64 @@ bindat-test--recursive
                                         (bindat-pack bindat-test--LEB128 n))
                          n)))))))
 
+(let ((spec (bindat-type :pack-var v
+                         (x strz 2 :pack-val v)
+                         :unpack-val x)))
+  (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") "\141\0")))
+
+  (ert-deftest bindat-test--strz-fixedlen-pack-overflow ()
+    :expected-result :failed
+    (should (equal (bindat-pack spec "abc") "\141\0")))
+
+  (ert-deftest bindat-test--strz-fixedlen-unpack ()
+    (should (equal (bindat-unpack spec "\0\0") ""))
+    (should (equal (bindat-unpack spec "a\0") "a"))))
+
+(let ((spec (bindat-type :pack-var v
+                         (x strz :pack-val v)
+                         :unpack-val x)))
+  (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") "\141\142\143\0")))
+
+  (ert-deftest bindat-test--strz-varlen-unpack ()
+    :expected-result :failed
+    (should (equal (bindat-unpack spec "\0") ""))
+    (should (equal (bindat-unpack spec "\141\142\143\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"))) "\141\0")))
+
+  (ert-deftest bindat-test--strz-legacy-fixedlen-pack-overflow ()
+    :expected-result :failed
+    (should (equal (bindat-pack spec '((x . "abc"))) "\141\0")))
+
+  (ert-deftest bindat-test--strz-legacy-fixedlen-unpack ()
+    (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: 1972 bytes --]

From af6899c1f6ecdeb75fcb43bea603e53cbe7a5f04 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            | 7 +++----
 test/lisp/emacs-lisp/bindat-tests.el | 2 --
 2 files changed, 3 insertions(+), 6 deletions(-)

diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index c6d64975ec..f66458296a 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -687,10 +687,9 @@ bindat--type
   (bindat--pcase op
     ('unpack `(bindat--unpack-strz ,len))
     (`(length ,val)
-     `(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)))))
     (`(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 53c0c359d8..ea6d110b8b 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -188,12 +188,10 @@ bindat-test--recursive
                          (x strz :pack-val v)
                          :unpack-val x)))
   (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") "\141\142\143\0")))
 
-- 
2.36.1


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

From e504d1e850a544d6d139a51beee7ad5c2155c079 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 f66458296a..d64be721b2 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -692,13 +692,13 @@ bindat--type
                              `(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: 2270 bytes --]

From a7613f605ae0acbe3a3fd8cde397464706c88952 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 d64be721b2..12b2d20981 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -693,11 +693,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 ea6d110b8b..5152f67c01 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -177,7 +177,6 @@ bindat-test--recursive
     (should (equal (bindat-pack spec "a") "\141\0")))
 
   (ert-deftest bindat-test--strz-fixedlen-pack-overflow ()
-    :expected-result :failed
     (should (equal (bindat-pack spec "abc") "\141\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: 1828 bytes --]

From 787ea356aba16bcf9dd1f41d55e3ab7e1129215c 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 12b2d20981..20095ef6cd 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 5152f67c01..01f9d51ad0 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -195,7 +195,6 @@ bindat-test--recursive
     (should (equal (bindat-pack spec "abc") "\141\142\143\0")))
 
   (ert-deftest bindat-test--strz-varlen-unpack ()
-    :expected-result :failed
     (should (equal (bindat-unpack spec "\0") ""))
     (should (equal (bindat-unpack spec "\141\142\143\0") "abc"))))
 
-- 
2.36.1


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

From 830eeae41522ce5885021c189e0d03c071fe4fc6 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 20095ef6cd..cf17e5764d 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)
@@ -690,17 +698,7 @@ bindat--type
      `(cl-incf bindat-idx ,(if (numberp len)
                                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: 1700 bytes --]

From 08d1666b99533f8a72a4ef2c8abe77be8058d0e0 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 cf17e5764d..e8eb59e24d 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 01f9d51ad0..ca93a2468b 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -211,7 +211,6 @@ bindat-test--recursive
     (should (equal (bindat-pack spec '((x . "a"))) "\141\0")))
 
   (ert-deftest bindat-test--strz-legacy-fixedlen-pack-overflow ()
-    :expected-result :failed
     (should (equal (bindat-pack spec '((x . "abc"))) "\141\0")))
 
   (ert-deftest bindat-test--strz-legacy-fixedlen-unpack ()
-- 
2.36.1


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