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).
This commit is contained in:
parent
ade2f38ee3
commit
1a59003b13
2 changed files with 102 additions and 7 deletions
|
|
@ -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 ()
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue