From 344bec1fa01ff4d12c352c220237fe8c262e91a4 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sun, 12 Jun 2022 01:19:43 -0400
Subject: [PATCH v2] bindat (str, strz): Reject non-ASCII, non-`eight-bit'
 characters

* lisp/emacs-lisp/bindat.el (str) (strz): Signal an error if the user
attempts to pack a multibyte string containing characters other than
ASCII and `eight-bit' characters (bug#55897).
* doc/lispref/processes.texi (Bindat Types): Update documentation.
* test/lisp/emacs-lisp/bindat-tests.el (str) (strz): Add tests.
---
 doc/lispref/processes.texi           | 14 ++++++++++----
 lisp/emacs-lisp/bindat.el            | 10 ++++++----
 test/lisp/emacs-lisp/bindat-tests.el | 16 ++++++++++++++++
 3 files changed, 32 insertions(+), 8 deletions(-)

diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index aa4d0e3ee4..8c8f8fd6b2 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -3486,8 +3486,11 @@ Bindat Types
 to the packed output.  If the input string is shorter than @var{len},
 the remaining bytes will be null (zero) unless a pre-allocated string
 was provided to @code{bindat-pack}, in which case the remaining bytes
-are left unmodified.  When unpacking, any null bytes in the packed
-input string will appear in the unpacked output.
+are left unmodified.  If the input string is multibyte with only ASCII
+and @code{eight-bit} characters, it is converted to unibyte before it
+is packed; other multibyte strings signal an error.  When unpacking,
+any null bytes in the packed input string will appear in the unpacked
+output.
 
 @item strz &optional @var{len}
 If @var{len} is not provided: Variable-length null-terminated unibyte
@@ -3497,8 +3500,11 @@ Bindat Types
 @code{bindat-pack}, in which case that byte is left unmodified.  The
 length of the packed output is the length of the input string plus one
 (for the null terminator).  The input string must not contain any null
-bytes.  When unpacking, the resulting string contains all bytes up to
-(but excluding) the null byte.
+bytes.  If the input string is multibyte with only ASCII and
+@code{eight-bit} characters, it is converted to unibyte before it is
+packed; other multibyte strings signal an error.  When unpacking, the
+resulting string contains all bytes up to (but excluding) the null
+byte.
 
 @quotation Caution
 If a pre-allocated string is provided to @code{bindat-pack}, the
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 84d5ea1e3b..2d6589b52d 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -435,12 +435,14 @@ bindat--pack-u64r
   (bindat--pack-u32r (ash v -32)))
 
 (defun bindat--pack-str (len v)
-  (dotimes (i (min len (length v)))
-    (aset bindat-raw (+ bindat-idx i) (aref v i)))
-  (setq bindat-idx (+ bindat-idx len)))
+  (let ((v (string-to-unibyte v)))
+    (dotimes (i (min len (length v)))
+      (aset bindat-raw (+ bindat-idx i) (aref v i)))
+    (setq bindat-idx (+ bindat-idx len))))
 
 (defun bindat--pack-strz (v)
-  (let ((len (length v)))
+  (let* ((v (string-to-unibyte v))
+         (len (length v)))
     (dotimes (i len)
       (aset bindat-raw (+ bindat-idx i) (aref v i)))
     (setq bindat-idx (+ bindat-idx len 1))))
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index 1ce402977f..8bb3baa485 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -188,6 +188,22 @@ bindat-test--str-strz-prealloc
       (apply #'bindat-pack (append (car tc) (list prealloc)))
       (should (equal prealloc (cdr tc))))))
 
+(ert-deftest bindat-test--str-strz-multibyte ()
+  (dolist (spec (list (bindat-type str 2)
+                      (bindat-type strz 2)
+                      (bindat-type strz)))
+    (should (equal (bindat-pack spec (string-to-multibyte "x")) "x\0"))
+    (should (equal (bindat-pack spec (string-to-multibyte "\xff")) "\xff\0"))
+    (should-error (bindat-pack spec "💩"))
+    (should-error (bindat-pack spec "\N{U+ff}")))
+  (dolist (spec (list '((x str 2)) '((x strz 2))))
+    (should (equal (bindat-pack spec `((x . ,(string-to-multibyte "x"))))
+                   "x\0"))
+    (should (equal (bindat-pack spec `((x . ,(string-to-multibyte "\xff"))))
+                   "\xff\0"))
+    (should-error (bindat-pack spec '((x . "💩"))))
+    (should-error (bindat-pack spec '((x . "\N{U+ff}"))))))
+
 (let ((spec (bindat-type strz 2)))
   (ert-deftest bindat-test--strz-fixedlen-len ()
     (should (equal (bindat-length spec "") 2))
-- 
2.36.1