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} {
114 upvar #0 pids($site) pid
115 set cf $tmp/$site.conf
117 puts $ch [mkconf $location $site]
119 set argl [list $builddir/secnet -dvnc $cf]
120 set divertk SECNET_STEST_DIVERT_$site
121 puts -nonewline "spawn"
122 foreach k [array names env] {
124 SECNET_STEST_DIVERT_* -
125 SECNET_TEST_BUILDDIR { }
127 *PRELOAD* { puts -nonewline " $k=$env($k)" }
131 if {[info exists env($divertk)]} {
132 switch -glob $env($divertk) {
134 puts -nonewline "run ^ command, hit return "
142 set argl [split $env($divertk)]
146 if {[llength $argl]} {
149 execl [lindex $argl 0] [lrange $argl 1 end]
152 puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
155 proc netlink-readable {location site} {
157 upvar #0 netlinkfh($site.r) fh
158 read $fh; # empty the buffer
159 switch -exact $site {
162 set ok 1; # what a bodge
171 proc bgerror {message} {
172 global errorInfo errorCode
175 ----------------------------------------
180 ----------------------------------------
189 4500 0054 ed9d 4000 4001 24da ac12 e809
190 ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
191 0000 0000 507f 0b00 0000 0000 1011 1213
192 1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
193 2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
196 puts -nonewline $netlinkfh(inside.t) \
197 [hbytes h2raw c0[join $p ""]c0]
201 exec mkdir -p -m700 $socktmp
202 regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
204 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
206 set env(UDP_PRELOAD_DIR) $socktmp
207 prefix_preload $builddir/stest/udp-preload.so
210 global socktmp udpsock
213 regsub {^(?!/)} $u {./} u
214 set udpsock [dgram-socket create $u]
215 dgram-socket on-receive $udpsock udp-relay
218 proc udp-relay {data src sock args} {
219 global udpsock socktmp
220 set headerlen [expr {52+1}]
223 set dst [hbytes range $data 0 $headerlen]
224 regsub {(?:00)*$} $dst {} dst
225 set dst [hbytes h2raw $dst]
227 hbytes overwrite data 0 [hbytes zeroes $headerlen]
228 regsub {.*/} $src {} src
229 set srch [hbytes raw2h $src]
230 hbytes append srch 00
232 if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
233 if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
234 hbytes overwrite data 0 $srch
235 dgram-socket transmit $udpsock $data $socktmp/$dst
237 puts stderr "$orgsrc -> $dst: $emsg"
243 spawn-secnet in inside
244 spawn-secnet out outside