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-bid-net.el

@@ -143,6 +143,17 @@ and a hand exposed by an open misère is revealed to everyone."
 
 ;;;; Apply a move on the host
 
+(defun cg-bid--net-holds-p (hand cards)
+  "Return non-nil when every card in CARDS is present in HAND.
+Multiplicity counts: naming one held card five times is not holding
+five cards.  Cards are (SUIT . RANK) conses compared with `equal'."
+  (let ((left (copy-sequence hand)))
+    (catch 'missing
+      (dolist (c cards t)
+        (if (member c left)
+            (setq left (cl-remove c left :test #'equal :count 1))
+          (throw 'missing nil))))))
+
 (cl-defmethod cg-net-apply-move ((game cg-bid-game) seat move)
   "Apply MOVE made by absolute SEAT to the host's 500 GAME.
 MOVE is (bid BID), (pass), (discard CARD...) or (play CARD).  Return
@@ -157,7 +168,8 @@ non-nil when the move was legal and applied, so the host broadcasts."
          (cg-bid--auction-act game seat nil) (setq ok t)))
       (`(discard . ,cards)
        (when (and (eq phase 'kitty) (eql (cg-get game :contractor) seat)
-                  (= (length cards) 5))
+                  (= (length cards) 5)
+                  (cg-bid--net-holds-p (cg-bid--hand game seat) cards))
          (cg-bid--discard game seat cards) (setq ok t)))
       (`(play ,card)
        (when (and (eq phase 'play) (eql (cg-get game :turn) seat)

cg-net.el

@@ -60,6 +60,37 @@
   "Default TCP port used to host or join a game."
   :type 'integer :group 'cg-net)
 
+(defcustom cg-net-host-address "127.0.0.1"
+  "Address the host's listening socket binds when hosting a game.
+The default, \"127.0.0.1\", accepts connections only from this
+machine; remote players reach it through a tunnel they were
+deliberately given (for example ssh port forwarding), which also
+encrypts the traffic in transit.
+
+Setting this to \"0.0.0.0\" listens on every network interface, which
+means anyone able to reach this machine's port can take a seat: there
+is no password and no encryption on the wire.  That can be a
+reasonable choice on a trusted LAN, but it is a choice -- make it
+deliberately."
+  :type '(choice (const :tag "This machine only (recommended)" "127.0.0.1")
+                 (const :tag "Every interface (anyone who can reach you)" "0.0.0.0")
+                 (string :tag "A specific interface address"))
+  :group 'cg-net)
+
+(defcustom cg-net-max-line 65536
+  "Longest unterminated line accepted from a connection, in bytes.
+Messages in this protocol are short; 64 KiB is generous.  A connection
+whose pending (newline-less) data exceeds this is closed, so one peer
+cannot grow the line buffer until memory runs out."
+  :type 'integer :group 'cg-net)
+
+(defcustom cg-net-max-connections 8
+  "Most simultaneous client connections a host will accept.
+A table seats four, so the default leaves headroom without letting the
+client list grow unboundedly.  Connections beyond the limit are closed
+as they arrive."
+  :type 'integer :group 'cg-net)
+
 (defvar cg-net-state-functions nil
   "Abnormal hook run on a client after the game state is updated.
 Each function is called with the client's game object.")
@@ -99,9 +130,72 @@ private information; nil requests the full host view.")
     (let ((print-length nil) (print-level nil))
       (process-send-string proc (concat (prin1-to-string msg) "\n")))))
 
-(defun cg-net--filter (handler)
+(defun cg-net--scrub (x)
+  "Return X with text properties removed from every string inside it.
+Walks conses and vectors, tolerating shared and circular structure.
+Everything arriving over the network passes through this: text
+properties can rebind keys or carry expressions evaluated during
+redisplay, and there is never a reason to honour a remote peer's."
+  (let ((seen (make-hash-table :test 'eq)))
+    (cl-labels ((walk (v)
+                  (cond
+                   ((stringp v) (substring-no-properties v))
+                   ((consp v)
+                    (or (gethash v seen)
+                        (let ((cell (cons nil nil)))
+                          (puthash v cell seen)
+                          (setcar cell (walk (car v)))
+                          (setcdr cell (walk (cdr v)))
+                          cell)))
+                   ((vectorp v)
+                    (or (gethash v seen)
+                        (let ((copy (make-vector (length v) nil)))
+                          (puthash v copy seen)
+                          (dotimes (i (length v))
+                            (aset copy i (walk (aref v i))))
+                          copy)))
+                   (t v))))
+      (walk x))))
+
+(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)."
+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)
@@ -110,10 +204,20 @@ HANDLER is called with (PROC MSG)."
           (setq start (1+ nl))
           (unless (string-empty-p line)
             (condition-case err
-                (funcall handler proc (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)))))
         )
-      (process-put proc 'cg-net-buf (substring buf start)))))
+      (let ((rest (substring buf start)))
+        (if (> (length rest) cg-net-max-line)
+            (progn
+              (process-put proc 'cg-net-buf nil)
+              (message "cg-net: dropping %s (line over %d bytes)"
+                       (process-name proc) cg-net-max-line)
+              (delete-process proc))
+          (process-put proc 'cg-net-buf rest))))))
 
 ;;;; Host
 
@@ -128,11 +232,12 @@ HANDLER is called with (PROC MSG)."
   (and cg-net--host (process-live-p (cg-net-host-server cg-net--host))))
 
 (defun cg-net-host-start (game &optional port)
-  "Begin hosting GAME on PORT (default `cg-net-port').  Return the server process."
+  "Begin hosting GAME on PORT (default `cg-net-port').  Return the server process.
+The socket binds `cg-net-host-address' -- by default, this machine only."
   (let* ((port (or port cg-net-port))
          (server (make-network-process
                   :name "cg-host" :server t :service port
-                  :host "0.0.0.0" :family 'ipv4 :coding 'utf-8
+                  :host cg-net-host-address :family 'ipv4 :coding 'utf-8
                   :log #'cg-net--host-accept)))
     (setq cg-net--host (cg-net--host-make :server server :game game))
     server))
@@ -146,19 +251,39 @@ HANDLER is called with (PROC MSG)."
       (delete-process (cg-net-host-server cg-net--host)))
     (setq cg-net--host nil)))
 
+(defun cg-net--host-sentinel (proc _event)
+  "Reap PROC from the client list when its connection has ended.
+Without this, departed players stay listed forever and the host keeps
+sending to them.  Seat numbers are deliberately not reused: a stale
+seat must not be inherited by a stranger mid-game."
+  (unless (process-live-p proc)
+    (when cg-net--host
+      (setf (cg-net-host-clients cg-net--host)
+            (delq proc (cg-net-host-clients cg-net--host))))))
+
 (defun cg-net--host-accept (_server connection _message)
-  "Set up an accepted CONNECTION: assign a seat and send the current state."
+  "Set up an accepted CONNECTION: assign a seat and send the current state.
+A connection arriving past `cg-net-max-connections' is closed instead."
+  (if (>= (length (cl-remove-if-not #'process-live-p
+                                    (cg-net-host-clients cg-net--host)))
+          cg-net-max-connections)
+      (progn
+        (message "cg-net: refusing connection (table is at %d)"
+                 cg-net-max-connections)
+        (delete-process connection))
     (let ((seat (cg-net-host-next-seat cg-net--host)))
       (setf (cg-net-host-next-seat cg-net--host) (1+ seat))
       (push connection (cg-net-host-clients cg-net--host))
       (process-put connection 'cg-net-seat seat)
       (set-process-coding-system connection 'utf-8 'utf-8)
-    (set-process-filter connection (cg-net--filter #'cg-net--host-handle))
+      (set-process-sentinel connection #'cg-net--host-sentinel)
+      (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
                           :state (cg-net-game-state (cg-net-host-game cg-net--host) seat)))
-    (run-hook-with-args 'cg-net-connect-functions cg-net--host seat)))
+      (run-hook-with-args 'cg-net-connect-functions cg-net--host seat))))
 
 (defun cg-net--host-handle (proc msg)
   "Handle one message MSG from a client PROC on the host."
@@ -199,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

@@ -68,6 +68,200 @@
       (cg-net-disconnect)
       (cg-net-host-stop))))
 
+(ert-deftest cgt-net-strips-properties ()
+  "Text properties on wire strings are stripped at the boundary, both ways.
+Finding 2 of the 2026-07-29 review: a propertized hello :name from a
+client must reach the host bare, and a propertized :message from the
+host must reach the client bare."
+  (condition-case _
+      (delete-process
+       (make-network-process :name "cgt-probe3" :server t :service 0
+                             :host "127.0.0.1" :family 'ipv4))
+    (error (ert-skip "TCP not available")))
+  (cl-flet ((pump () (dotimes (_ 12) (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))
+           (cgame (make-instance 'cgt-net-game :env (list :counter 0))))
+      (unwind-protect
+          (progn
+            (cg-net-connect "127.0.0.1" port
+                            (propertize "Eve" 'keymap '(keymap)) cgame)
+            (pump)
+            ;; client -> host: the hello name arrives with no attachments
+            (let* ((conn (car (cg-net-host-clients cg-net--host)))
+                   (name (process-get conn 'cg-net-name)))
+              (should (equal name "Eve"))
+              (should-not (text-properties-at 0 name)))
+            ;; host -> client: a state string arrives with no attachments
+            (cg-put hgame :message
+                    (propertize "hi" 'keymap '(keymap) 'help-echo "boo"))
+            (cg-net-host-broadcast)
+            (pump)
+            (let ((m (cg-get cgame :message)))
+              (should (equal m "hi"))
+              (should-not (text-properties-at 0 m))))
+        (cg-net-disconnect)
+        (cg-net-host-stop)))))
+
+(ert-deftest cgt-net-host-loopback-default ()
+  "Hosting binds to this machine only unless deliberately widened.
+Finding 1 of the 2026-07-29 review: the default of
+`cg-net-host-address' is loopback, and the listening socket really
+binds it -- wider exposure is a setting the user turns on, not a
+silent default."
+  (should (equal "127.0.0.1" (default-value 'cg-net-host-address)))
+  (condition-case _
+      (delete-process
+       (make-network-process :name "cgt-probe4" :server t :service 0
+                             :host "127.0.0.1" :family 'ipv4))
+    (error (ert-skip "TCP not available")))
+  (let* ((hgame (make-instance 'cgt-net-game :env (list :counter 0)))
+         (srv (cg-net-host-start hgame 0)))
+    (unwind-protect
+        (should (equal [127 0 0 1]
+                       (substring (process-contact srv :local) 0 4)))
+      (cg-net-host-stop))))
+
+(ert-deftest cgt-net-line-cap ()
+  "A connection sending endless bytes with no newline is dropped.
+Finding 4 of the 2026-07-29 review: the partial-line buffer grew
+without limit, so one connection could consume all available memory.
+It is now bounded by `cg-net-max-line'."
+  (condition-case _
+      (delete-process
+       (make-network-process :name "cgt-probe5" :server t :service 0
+                             :host "127.0.0.1" :family 'ipv4))
+    (error (ert-skip "TCP not available")))
+  (cl-flet ((pump () (dotimes (_ 8) (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))
+           (raw (make-network-process :name "cgt-flood" :host "127.0.0.1"
+                                      :service port :family 'ipv4)))
+      (unwind-protect
+          (progn
+            (pump)
+            (let ((chunk (make-string 8192 ?a)))
+              (cl-loop repeat 10 while (process-live-p raw)
+                       do (ignore-errors (process-send-string raw chunk))
+                          (pump)))
+            ;; 80 KiB with no newline: the host must have hung up on us
+            (should-not (process-live-p raw)))
+        (when (process-live-p raw) (delete-process raw))
+        (cg-net-host-stop)))))
+
+(ert-deftest cgt-net-connection-cap ()
+  "Connections beyond `cg-net-max-connections' are refused.
+Finding 4's second bound: the client list cannot grow without limit."
+  (condition-case _
+      (delete-process
+       (make-network-process :name "cgt-probe6" :server t :service 0
+                             :host "127.0.0.1" :family 'ipv4))
+    (error (ert-skip "TCP not available")))
+  (cl-flet ((pump () (dotimes (_ 8) (accept-process-output nil 0.05))))
+    (let* ((cg-net-max-connections 2)
+           (hgame (make-instance 'cgt-net-game :env (list :counter 0)))
+           (srv (cg-net-host-start hgame 0))
+           (port (process-contact srv :service))
+           (procs nil))
+      (unwind-protect
+          (progn
+            (dotimes (i 3)
+              (push (make-network-process :name (format "cgt-c%d" i)
+                                          :host "127.0.0.1" :service port
+                                          :family 'ipv4)
+                    procs)
+              (pump))
+            (should (= 2 (length (cl-remove-if-not
+                                  #'process-live-p
+                                  (cg-net-host-clients cg-net--host)))))
+            ;; the newest connection is the one turned away
+            (should-not (process-live-p (car procs))))
+        (dolist (p procs) (when (process-live-p p) (delete-process p)))
+        (cg-net-host-stop)))))
+
+(ert-deftest cgt-net-reaps-disconnected ()
+  "A client that disconnects is removed from the host's client list.
+Finding 5 of the 2026-07-29 review: nothing watched for a connection
+ending, so departed players stayed listed forever and the host kept
+sending to them.  A process sentinel now reaps them."
+  (condition-case _
+      (delete-process
+       (make-network-process :name "cgt-probe7" :server t :service 0
+                             :host "127.0.0.1" :family 'ipv4))
+    (error (ert-skip "TCP not available")))
+  (cl-flet ((pump () (dotimes (_ 12) (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))
+           (cgame (make-instance 'cgt-net-game :env (list :counter 0))))
+      (unwind-protect
+          (progn
+            (cg-net-connect "127.0.0.1" port "Test" cgame)
+            (pump)
+            (should (= 1 (length (cg-net-host-clients cg-net--host))))
+            (cg-net-disconnect)
+            (pump)
+            (should (= 0 (length (cg-net-host-clients cg-net--host)))))
+        (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 ()
@@ -299,6 +493,33 @@
     (should-not (cg-net-apply-move g 0 '(play (0 . 0)))) ; wrong phase
     ))
 
+(ert-deftest cgt-bid-net-discard-checked ()
+  "The host rejects a kitty discard of cards the seat does not hold.
+Finding 3 of the 2026-07-29 review: the other move checks were real,
+but a discard only counted its cards, and cl-set-difference silently
+ignores cards that are not in the hand -- so five phantom discards
+left a 15-card hand in play."
+  (let* ((cg-bid--human-seats '(0 1 2 3))
+         (g (cg-bid--deal (make-instance 'cg-bid-game) 3)))
+    ;; put the game where a discard is legal: West won the auction
+    (cg-put g :phase 'kitty)
+    (cg-put g :contractor 1)
+    (cg-bid--set-hand g 1 (append (cg-get g :kitty) (cg-bid--hand g 1)))
+    (let* ((hand (copy-sequence (cg-bid--hand g 1)))
+           (foreign (cl-subseq (cg-bid--hand g 2) 0 5)))
+      ;; five cards West does not hold: refused, nothing moves
+      (should-not (cg-net-apply-move g 1 (cons 'discard foreign)))
+      (should (equal hand (cg-bid--hand g 1)))
+      (should (eq 'kitty (cg-get g :phase)))
+      ;; one held card named five times: also refused
+      (should-not (cg-net-apply-move g 1
+                                     (cons 'discard (make-list 5 (car hand)))))
+      (should (eq 'kitty (cg-get g :phase)))
+      ;; an honest five from the hand is accepted and play begins
+      (should (cg-net-apply-move g 1 (cons 'discard (cl-subseq hand 0 5))))
+      (should (eq 'play (cg-get g :phase)))
+      (should (= 10 (length (cg-bid--hand g 1)))))))
+
 (ert-deftest cgt-bid-net-loopback ()
   "A 500 move travels client -> host -> filtered broadcast over TCP."
   (condition-case _