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 set privkey(inside) test-example/inside.privkeys/
29 set privkey(outside) test-example/outside.privkeys/
33 proc sitesconf_hook {l} { return $l }
35 proc oldsecnet {site} {
36 upvar #0 oldsecnet($site) oldsecnet
37 expr {[info exists oldsecnet] && [set oldsecnet]}
40 proc mkconf {location site} {
47 upvar #0 privkey($site) privkey
48 set pipefp $tmp/$site.netlink
50 file delete $pipefp.$tr
51 exec mkfifo -m600 $pipefp.$tr
52 set netlinkfh($site.$tr) [set fh [open $pipefp.$tr r+]]
53 fconfigure $fh -blocking 0 -buffering none -translation binary
55 fileevent $netlinkfh($site.r) readable \
56 [list netlink-readable $location $site]
57 set fakeuf $tmp/$site.fake-userv
58 set fakeuh [open $fakeuf w 0755]
59 puts $fakeuh "#!/bin/sh
62 cat <&3 3<&- >$pipefp.r &
73 userv-path \"$fakeuf\";
76 buffer sysbuffer(2048);
77 interface \"secnet-test-[string range $site 0 0]\";
82 foreach port $ports($site) {
86 address \"::1\", \"127.0.0.1\";
87 buffer sysbuffer(4096);
93 local-name \"test-example/$location/$site\";
95 switch -glob $privkey {
97 set sitesconf sites.conf
99 key-cache priv-cache({
100 privkeys \"$builddir/${privkey}priv.\";
105 set sitesconf sites-nonego.conf
107 local-key rsa-private(\"$builddir/$privkey\");
111 set sitesconf $builddir/test-example/$sitesconf
113 append cfg $extra($site)
117 class \"debug\",\"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\";
119 if {[oldsecnet $site]} { append cfg "
120 filename \"/dev/stderr\";
131 random randomfile("/dev/urandom",no);
132 transform eax-serpent { }, serpent256-cbc { };
135 set pubkeys $tmp/$site.pubkeys
136 file delete -force $pubkeys
137 exec cp -rl $builddir/test-example/pubkeys $pubkeys
139 set f [open $sitesconf r]
140 while {[gets $f l] >= 0} {
141 regsub {\"[^\"]*test-example/pubkeys/} $l "\"$pubkeys/" l
142 set l [sitesconf_hook $l]
149 sites map(site,all-sites);
155 proc spawn-secnet {location site} {
162 upvar #0 pids($site) pid
163 set readbuf($site) {}
164 set cf $tmp/$site.conf
166 puts $ch [mkconf $location $site]
168 set secnet $builddir/secnet
169 if {[oldsecnet $site]} {
170 set secnet $env(OLD_SECNET_DIR)/secnet
172 set argl [list $secnet -dvnc $cf]
173 set divertk SECNET_STEST_DIVERT_$site
174 puts -nonewline "spawn"
175 foreach k [array names env] {
177 SECNET_STEST_DIVERT_* -
178 SECNET_TEST_BUILDDIR - OLD_SECNET_DIR { }
180 *PRELOAD* { puts -nonewline " $k=$env($k)" }
184 if {[info exists env($divertk)]} {
185 switch -glob $env($divertk) {
187 puts -nonewline "run ^ command, hit return "
195 set argl [split $env($divertk)]
199 if {[llength $argl]} {
201 set pidmap($pid) "secnet $location/$site"
203 execl [lindex $argl 0] [lrange $argl 1 end]
206 puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
209 proc netlink-readable {location site} {
211 upvar #0 readbuf($site) buf
212 upvar #0 netlinkfh($site.r) fh
215 set h [hbytes raw2h $x]
216 if {![hbytes length $h]} return
218 #puts "READABLE $site buf=$buf"
219 while {[regexp {^((?:..)*?)c0(.*)$} $buf dummy now buf]} {
220 #puts "READABLE $site now=$now (buf=$buf)"
221 regsub -all {^((?:..)*?)dbdc} $now {\1c0} now
222 regsub -all {^((?:..)*?)dbdd} $now {\1db} now
223 puts "netlink-got-packet $location $site $now"
224 netlink-got-packet $location $site $now
229 proc netlink-got-packet {location site data} {
231 if {![hbytes length $data]} return
232 switch -exact $site!$initiator {
233 inside!inside - outside!outside {
235 45000054ed9d4000fe0166d9ac12e802ac12e80900* {
240 error "unexpected $site $data"
245 error "$site rx'd! (initiator $initiator)"
250 proc bgerror {message} {
251 global errorInfo errorCode
254 ----------------------------------------
259 ----------------------------------------
269 4500 0054 ed9d 4000 4001 24da ac12 e809
270 ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
271 0000 0000 507f 0b00 0000 0000 1011 1213
272 1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
273 2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
276 puts -nonewline $netlinkfh($initiator.t) \
277 [hbytes h2raw c0[join $p ""]c0]
281 exec mkdir -p -m700 $socktmp
282 regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
284 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
286 set env(UDP_PRELOAD_DIR) $socktmp
287 prefix_preload $builddir/stest/udp-preload.so
289 proc finish {estatus} {
290 puts stderr "FINISHING $estatus"
291 signal default SIGCHLD
293 foreach pid [array names pidmap] {
302 foreach pid [array names pidmap] {
303 set got [wait -nohang $pid]
304 if {![llength $got]} continue
305 set info $pidmap($pid)
307 puts stderr "reaped $info: $got"
312 signal -restart trap SIGCHLD { after idle reap }
315 global socktmp udpsock
318 regsub {^(?!/)} $u {./} u
319 set udpsock [dgram-socket create $u]
320 dgram-socket on-receive $udpsock udp-relay
323 proc udp-relay {data src sock args} {
324 global udpsock socktmp
325 set headerlen [expr {52+1}]
328 set dst [hbytes range $data 0 $headerlen]
329 regsub {(?:00)*$} $dst {} dst
330 set dst [hbytes h2raw $dst]
332 hbytes overwrite data 0 [hbytes zeroes $headerlen]
333 regsub {.*/} $src {} src
334 set srch [hbytes raw2h $src]
335 hbytes append srch 00
337 if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
338 if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
339 hbytes overwrite data 0 $srch
340 dgram-socket transmit $udpsock $data $socktmp/$dst
342 puts stderr "$orgsrc -> $dst: $emsg"
348 spawn-secnet in inside
349 spawn-secnet out outside