cg-net: check a message is well shaped before any code walks it

Finding 6 of the 2026-07-29 security review: messages became data
structures before anyone checked them.  read never executes code, but
it can be made to yield self-referential structure (which hangs
ordinary list walks, plist-get included), objects that impersonate
internal record types (#s syntax yields real hash tables and records),
and any number of fresh symbols.

cg-net--valid-p accepts what is recognised: a proper, even-length
plist whose :type is in the per-peer whitelist -- the host accepts
(hello move), a client accepts (welcome state full) -- built only from
conses, vectors, strings, numbers and symbols, with no shared or
circular structure, at most cg-net-max-nodes nodes.  The check runs in
cg-net--filter before the Finding 2 scrub, so nothing cyclic or opaque
reaches scrub, handlers, or game code.  The cycle-tolerance of the
scrub walker remains as a second belt.

Named leftovers (in PATCHES.md): symbols are interned by read before
validation can see them, bounded only by Finding 4 line cap; and shape
is not semantics -- a hostile host can still send absurd but
well-shaped state, which is the reserved trust-model question.

Test cgt-net-shape-gate fails against the previous code with the
receipt (equal (5 (1 2 1 2 . #2) #s(hash-table)) (5)) -- the cycle and
the hash table both reached cg-net-apply-move.  cgt-net-valid-p pins
the unit contract (void-function before the patch).

cg-net.el

@@ -157,10 +157,45 @@ redisplay, and there is never a reason to honour a remote peer's."
                    (t v))))
       (walk x))))
 
-(defun cg-net--filter (handler)
+(defconst cg-net-max-nodes 20000
+  "Upper bound on the number of nodes accepted in one wire message.")
+
+(defun cg-net--valid-p (msg types)
+  "Return non-nil when MSG is a well-shaped protocol message.
+TYPES is the list of message-type symbols accepted from this peer.
+MSG must be a proper plist whose `:type' is in TYPES, built only from
+conses, vectors, strings, numbers and symbols, with no shared or
+circular structure and at most `cg-net-max-nodes' nodes.  Accept what
+is recognised rather than trying to spot what is bad: parsed text can
+carry self-references that hang code walking them, and objects that
+impersonate internal record types."
+  (let ((seen (make-hash-table :test 'eq))
+        (nodes 0))
+    (cl-labels ((clean-p (v)
+                  (cond
+                   ((> (cl-incf nodes) cg-net-max-nodes) nil)
+                   ((consp v)
+                    (and (not (gethash v seen))
+                         (progn (puthash v t seen)
+                                (and (clean-p (car v)) (clean-p (cdr v))))))
+                   ((vectorp v)
+                    (and (not (gethash v seen))
+                         (progn (puthash v t seen)
+                                (cl-every #'clean-p v))))
+                   ((or (stringp v) (numberp v) (symbolp v)) t)
+                   (t nil))))
+      (and (consp msg)
+           (clean-p msg)                      ; safe before plist-get: no cycles past here
+           (null (cdr (last msg)))            ; a proper list
+           (cl-evenp (length msg))            ; of key/value pairs
+           (memq (plist-get msg :type) types)))))
+
+(defun cg-net--filter (handler types)
   "Return a process filter dispatching each complete line to HANDLER.
-HANDLER is called with (PROC MSG).  Strings inside MSG have their text
+HANDLER is called with (PROC MSG) for each line that parses into a
-properties stripped (`cg-net--scrub') before HANDLER sees them."
+well-shaped message (`cg-net--valid-p') whose type is in TYPES;
+strings inside MSG have their text properties stripped first, by
+`cg-net--scrub'.  Anything else is dropped where it lands."
   (lambda (proc string)
     (let ((buf (concat (or (process-get proc 'cg-net-buf) "") string))
           (start 0) nl)
@@ -169,8 +204,10 @@ properties stripped (`cg-net--scrub') before HANDLER sees them."
           (setq start (1+ nl))
           (unless (string-empty-p line)
             (condition-case err
-                (funcall handler proc
+                (let ((msg (car (read-from-string line))))
-                         (cg-net--scrub (car (read-from-string line))))
+                  (if (cg-net--valid-p msg types)
+                      (funcall handler proc (cg-net--scrub msg))
+                    (message "cg-net: dropped malformed message")))
               (error (message "cg-net: bad message: %S" err)))))
         )
       (let ((rest (substring buf start)))
@@ -240,7 +277,8 @@ A connection arriving past `cg-net-max-connections' is closed instead."
       (process-put connection 'cg-net-seat seat)
       (set-process-coding-system connection 'utf-8 'utf-8)
       (set-process-sentinel connection #'cg-net--host-sentinel)
-      (set-process-filter connection (cg-net--filter #'cg-net--host-handle))
+      (set-process-filter connection
+                          (cg-net--filter #'cg-net--host-handle '(hello move)))
       (cg-net--send connection (list :type 'welcome :seat seat))
       (cg-net--send connection
                     (list :type 'state
@@ -286,7 +324,9 @@ Return the new `cg-net-client'."
                :family 'ipv4 :coding 'utf-8)))
     (setq cg-net--client (cg-net--client-make :proc proc :game game))
     (set-process-coding-system proc 'utf-8 'utf-8)
-    (set-process-filter proc (cg-net--filter #'cg-net--client-handle))
+    (set-process-filter proc
+                        (cg-net--filter #'cg-net--client-handle
+                                        '(welcome state full)))
     (cg-net--send proc (list :type 'hello :name name))
     cg-net--client))
 

test/card-games-tests.el

@@ -207,6 +207,61 @@ sending to them.  A process sentinel now reaps them."
         (cg-net-disconnect)
         (cg-net-host-stop)))))
 
+(ert-deftest cgt-net-shape-gate ()
+  "Malformed messages are dropped before any game code sees them.
+Finding 6 of the 2026-07-29 review: parsing can produce structures
+that hang or confuse code walking them -- self-references, objects
+impersonating internal types.  A message must be a proper plist of a
+known :type built from plain data; anything else never reaches
+`cg-net-apply-move'."
+  (condition-case _
+      (delete-process
+       (make-network-process :name "cgt-probe8" :server t :service 0
+                             :host "127.0.0.1" :family 'ipv4))
+    (error (ert-skip "TCP not available")))
+  (cl-flet ((pump () (dotimes (_ 10) (accept-process-output nil 0.05))))
+    (let* ((hgame (make-instance 'cgt-net-game :env (list :counter 0)))
+           (srv (cg-net-host-start hgame 0))
+           (port (process-contact srv :service))
+           (applied nil))
+      (cl-letf (((symbol-function 'cg-net-apply-move)
+                 (lambda (_game _seat move) (push move applied) nil)))
+        (let ((raw (make-network-process :name "cgt-shapes" :host "127.0.0.1"
+                                         :service port :family 'ipv4)))
+          (unwind-protect
+              (progn
+                (pump)
+                (dolist (line '("(:type move :move #s(hash-table size 1))"
+                                "(:type move :move #1=(1 2 . #1#))"
+                                "42"
+                                "(:type welcome :seat 3)"
+                                "(:type move :move 5)"))
+                  (process-send-string raw (concat line "\n")))
+                (pump)
+                ;; only the one well-shaped, host-legal move arrived
+                (should (equal applied (list 5))))
+            (when (process-live-p raw) (delete-process raw))
+            (cg-net-host-stop)))))))
+
+(ert-deftest cgt-net-valid-p ()
+  "Unit contract of the wire-shape check itself."
+  (should (cg-net--valid-p '(:type move :move (bid (7 . 3))) '(hello move)))
+  (should (cg-net--valid-p '(:type hello :name "n") '(hello move)))
+  ;; wrong direction: a host does not accept host->client types
+  (should-not (cg-net--valid-p '(:type welcome :seat 1) '(hello move)))
+  ;; not a plist / unknown / impersonating / shared structure
+  (should-not (cg-net--valid-p 42 '(hello move)))
+  (should-not (cg-net--valid-p '(:type reboot) '(hello move)))
+  (should-not (cg-net--valid-p (list :type 'move :move (make-hash-table))
+                               '(hello move)))
+  (should-not (cg-net--valid-p (record 'cg-net-host nil nil nil 0) '(hello move)))
+  (let ((shared (list 1 2)))
+    (should-not (cg-net--valid-p (list :type 'move :move (list shared shared))
+                                 '(hello move))))
+  (let ((cyc (list 1 2)))
+    (setcdr (cdr cyc) cyc)
+    (should-not (cg-net--valid-p (list :type 'move :move cyc) '(hello move)))))
+
 ;;;; Gaps
 
 (ert-deftest cgt-gaps-deal ()