From 1a59003b13c8660bf6ae41c9197b2224e1ad192b Mon Sep 17 00:00:00 2001 From: Claude Date: Mon, 3 Aug 2026 20:37:36 -0500 Subject: [PATCH] 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 | 54 ++++++++++++++++++++++++++++++++++----- test/card-games-tests.el | 55 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 102 insertions(+), 7 deletions(-) diff --git a/cg-net.el b/cg-net.el index 42a5105..ac054df 100644 --- a/cg-net.el +++ b/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 -properties stripped (`cg-net--scrub') before HANDLER sees them." +HANDLER is called with (PROC MSG) for each line that parses into a +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 - (cg-net--scrub (car (read-from-string line)))) + (let ((msg (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)) diff --git a/test/card-games-tests.el b/test/card-games-tests.el index c74f344..216e25f 100644 --- a/test/card-games-tests.el +++ b/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 ()