From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 24 Nov 2019 00:59:31 +0000 (+0000)
Subject: stest: Decode the slip packets that come via fake netlink
X-Git-Tag: v0.6.0~228
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=secnet.git;a=commitdiff_plain;h=d939e5444828922f90b2646405025b4dd81f8988

stest: Decode the slip packets that come via fake netlink

This will allow us to do something more sophisticated with the packet
contents.

The only functional change right now is to ignore empty `packets'.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---

diff --git a/stest/common.tcl b/stest/common.tcl
index a58ca6f..566757c 100644
--- a/stest/common.tcl
+++ b/stest/common.tcl
@@ -112,7 +112,9 @@ proc spawn-secnet {location site} {
     global netlinkfh
     global env
     global pidmap
+    global readbuf
     upvar #0 pids($site) pid
+    set readbuf($site) {}
     set cf $tmp/$site.conf
     set ch [open $cf w]
     puts $ch [mkconf $location $site]
@@ -156,8 +158,26 @@ proc spawn-secnet {location site} {
 
 proc netlink-readable {location site} {
     global ok
+    upvar #0 readbuf($site) buf
     upvar #0 netlinkfh($site.r) fh
-    read $fh; # empty the buffer
+    while 1 {
+	set x [read $fh]
+	set h [hbytes raw2h $x]
+	if {![hbytes length $h]} return
+	append buf $h
+	#puts "READABLE $site buf=$buf"
+	while {[regexp {^((?:..)*?)c0(.*)$} $buf dummy now buf]} {
+	    #puts "READABLE $site now=$now (buf=$buf)"
+	    regsub -all {^((?:..)*?)dbdc} $now {\1c0} now
+	    regsub -all {^((?:..)*?)dbdd} $now {\1db} now
+	    puts "netlink-got-packet $location $site $now"
+	    netlink-got-packet $location $site $now
+	}
+    }
+}
+
+proc netlink-got-packet {location site data} {
+    if {![hbytes length $data]} return 
     switch -exact $site {
 	inside {
 	    puts OK