diff --git a/cg-net.el b/cg-net.el index 8019c5e..fd7861d 100644 --- a/cg-net.el +++ b/cg-net.el @@ -99,9 +99,37 @@ 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--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)))) + (defun cg-net--filter (handler) "Return a process filter dispatching each complete line to HANDLER. -HANDLER is called with (PROC MSG)." +HANDLER is called with (PROC MSG). Strings inside MSG have their text +properties stripped (`cg-net--scrub') before HANDLER sees them." (lambda (proc string) (let ((buf (concat (or (process-get proc 'cg-net-buf) "") string)) (start 0) nl) @@ -110,7 +138,8 @@ 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))) + (funcall handler proc + (cg-net--scrub (car (read-from-string line)))) (error (message "cg-net: bad message: %S" err))))) ) (process-put proc 'cg-net-buf (substring buf start))))) diff --git a/test/card-games-tests.el b/test/card-games-tests.el index ccb113b..0579310 100644 --- a/test/card-games-tests.el +++ b/test/card-games-tests.el @@ -68,6 +68,42 @@ (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))))) + ;;;; Gaps (ert-deftest cgt-gaps-deal ()