5 load chiark_tcl_hbytes-1.so
6 load chiark_tcl_dgram-1.so
9 local-address "172.18.232.9";
10 secnet-address "172.18.232.10";
11 remote-networks "172.18.232.0/28";
13 set netlink(outside) {
14 local-address "172.18.232.1";
15 secnet-address "172.18.232.2";
16 remote-networks "172.18.232.0/28";
19 set ports(inside) {16913 16910}
20 set ports(outside) 16900
28 proc mkconf {location site} {
35 set pipefp $tmp/$site.netlink
37 file delete $pipefp.$tr
38 exec mkfifo -m600 $pipefp.$tr
39 set netlinkfh($site.$tr) [set fh [open $pipefp.$tr r+]]
40 fconfigure $fh -blocking 0 -buffering none -translation binary
42 fileevent $netlinkfh($site.r) readable \
43 [list netlink-readable $location $site]
44 set fakeuf $tmp/$site.fake-userv
45 set fakeuh [open $fakeuf w 0755]
46 puts $fakeuh "#!/bin/sh
49 cat <&3 3<&- >$pipefp.r &
59 userv-path \"$fakeuf\";
62 buffer sysbuffer(2048);
63 interface \"secnet-test-[string range $site 0 0]\";
68 foreach port $ports($site) {
72 address \"::1\", \"127.0.0.1\";
73 buffer sysbuffer(4096);
79 local-name \"test-example/$location/$site\";
80 local-key rsa-private(\"$builddir/test-example/$site.key\");
82 append cfg $extra($site)
86 class \"debug\",\"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\";
95 random randomfile("/dev/urandom",no);
96 transform eax-serpent { }, serpent256-cbc { };
99 set f [open $builddir/test-example/sites.conf r]
104 sites map(site,all-sites);
109 proc spawn-secnet {location site} {
116 upvar #0 pids($site) pid
117 set readbuf($site) {}
118 set cf $tmp/$site.conf
120 puts $ch [mkconf $location $site]
122 set argl [list $builddir/secnet -dvnc $cf]
123 set divertk SECNET_STEST_DIVERT_$site
124 puts -nonewline "spawn"
125 foreach k [array names env] {
127 SECNET_STEST_DIVERT_* -
128 SECNET_TEST_BUILDDIR { }
130 *PRELOAD* { puts -nonewline " $k=$env($k)" }
134 if {[info exists env($divertk)]} {
135 switch -glob $env($divertk) {
137 puts -nonewline "run ^ command, hit return "
145 set argl [split $env($divertk)]
149 if {[llength $argl]} {
151 set pidmap($pid) "secnet $location/$site"
153 execl [lindex $argl 0] [lrange $argl 1 end]
156 puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
159 proc netlink-readable {location site} {
161 upvar #0 readbuf($site) buf
162 upvar #0 netlinkfh($site.r) fh
165 set h [hbytes raw2h $x]
166 if {![hbytes length $h]} return
168 #puts "READABLE $site buf=$buf"
169 while {[regexp {^((?:..)*?)c0(.*)$} $buf dummy now buf]} {
170 #puts "READABLE $site now=$now (buf=$buf)"
171 regsub -all {^((?:..)*?)dbdc} $now {\1c0} now
172 regsub -all {^((?:..)*?)dbdd} $now {\1db} now
173 puts "netlink-got-packet $location $site $now"
174 netlink-got-packet $location $site $now
179 proc netlink-got-packet {location site data} {
180 if {![hbytes length $data]} return
181 switch -exact $site {
192 proc bgerror {message} {
193 global errorInfo errorCode
196 ----------------------------------------
201 ----------------------------------------
210 4500 0054 ed9d 4000 4001 24da ac12 e809
211 ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
212 0000 0000 507f 0b00 0000 0000 1011 1213
213 1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
214 2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
217 puts -nonewline $netlinkfh(inside.t) \
218 [hbytes h2raw c0[join $p ""]c0]
222 exec mkdir -p -m700 $socktmp
223 regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
225 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
227 set env(UDP_PRELOAD_DIR) $socktmp
228 prefix_preload $builddir/stest/udp-preload.so
230 proc finish {estatus} {
231 puts stderr "FINISHING $estatus"
232 signal default SIGCHLD
234 foreach pid [array names pidmap] {
243 foreach pid [array names pidmap] {
244 set got [wait -nohang $pid]
245 if {![llength $got]} continue
246 set info $pidmap($pid)
248 puts stderr "reaped $info: $got"
253 signal -restart trap SIGCHLD { after idle reap }
256 global socktmp udpsock
259 regsub {^(?!/)} $u {./} u
260 set udpsock [dgram-socket create $u]
261 dgram-socket on-receive $udpsock udp-relay
264 proc udp-relay {data src sock args} {
265 global udpsock socktmp
266 set headerlen [expr {52+1}]
269 set dst [hbytes range $data 0 $headerlen]
270 regsub {(?:00)*$} $dst {} dst
271 set dst [hbytes h2raw $dst]
273 hbytes overwrite data 0 [hbytes zeroes $headerlen]
274 regsub {.*/} $src {} src
275 set srch [hbytes raw2h $src]
276 hbytes append srch 00
278 if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
279 if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
280 hbytes overwrite data 0 $srch
281 dgram-socket transmit $udpsock $data $socktmp/$dst
283 puts stderr "$orgsrc -> $dst: $emsg"
289 spawn-secnet in inside
290 spawn-secnet out outside