3 load chiark_tcl_hbytes-1.so
4 load chiark_tcl_dgram-1.so
7 local-address "172.18.232.9";
8 secnet-address "172.18.232.10";
9 remote-networks "172.18.232.0/28";
11 set netlink(outside) {
12 local-address "172.18.232.1";
13 secnet-address "172.18.232.2";
14 remote-networks "172.18.232.0/28";
17 set ports(inside) {16913 16910}
18 set ports(outside) 16900
32 set pipefp $tmp/$which.netlink
34 file delete $pipefp.$tr
35 exec mkfifo -m600 $pipefp.$tr
36 set netlinkfh($which.$tr) [set fh [open $pipefp.$tr r+]]
37 fconfigure $fh -blocking 0 -buffering none -translation binary
39 fileevent $netlinkfh($which.r) readable [list netlink-readable $which]
40 set fakeuf $tmp/$which.fake-userv
41 set fakeuh [open $fakeuf w 0755]
42 puts $fakeuh "#!/bin/sh
45 cat <&3 3<&- >$pipefp.r &
55 userv-path \"$fakeuf\";
58 buffer sysbuffer(2048);
59 interface \"secnet-test-[string range $which 0 0]\";
64 foreach port $ports($which) {
68 address \"::1\", \"127.0.0.1\";
69 buffer sysbuffer(4096);
75 local-name \"test-example/$which/$which\";
76 local-key rsa-private(\"test-example/$which.key\");
78 append cfg $extra($which)
82 class "info","notice","warning","error","security","fatal";
89 random randomfile("/dev/urandom",no);
90 transform eax-serpent { }, serpent256-cbc { };
91 include test-example/sites.conf
92 sites map(site,vpn/test-example/all-sites);
97 proc spawn-secnet {which} {
100 upvar #0 pids($which) pid
101 set cf $tmp/$which.conf
103 puts $ch [mkconf $which]
105 set argl [list strace -o$tmp/$which.strace ./secnet -dvnc $cf]
108 execl [lindex $argl 0] [lrange $argl 1 end]
110 puts -nonewline $netlinkfh($which.t) [hbytes h2raw c0]
113 proc netlink-readable {which} {
115 upvar #0 netlinkfh($which.r) fh
116 read $fh; # empty the buffer
117 switch -exact $which {
120 set ok 1; # what a bodge
129 proc bgerror {message} {
130 global errorInfo errorCode
133 ----------------------------------------
138 ----------------------------------------
147 4500 0054 ed9d 4000 4001 24da ac12 e809
148 ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
149 0000 0000 507f 0b00 0000 0000 1011 1213
150 1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
151 2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
154 puts -nonewline $netlinkfh(inside.t) \
155 [hbytes h2raw c0[join $p ""]c0]
161 exec mkdir -p -m700 $socktmp
162 regsub {^(?!/)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
164 proc prefix_preload {lib} {
167 catch { set l [split $env(PRELOAD) :] }
168 set l [concat [list $lib] $l]
169 set env(LD_PRELOAD) [join $l :]
172 set env(UDP_PRELOAD_DIR) $socktmp
173 prefix_preload test/udp-preload.so
176 global socktmp udpsock
179 regsub {^(?!/)} $u {./} u
180 set udpsock [dgram-socket create $u]
181 dgram-socket on-receive $udpsock udp-relay
184 proc udp-relay {data src sock args} {
185 global udpsock socktmp
186 set headerlen [expr {52+1}]
189 set dst [hbytes range $data 0 $headerlen]
190 regsub {(?:00)*$} $dst {} dst
191 set dst [hbytes h2raw $dst]
193 hbytes overwrite data 0 [hbytes zeroes $headerlen]
194 regsub {.*/} $src {} src
195 set srch [hbytes raw2h $src]
196 hbytes append srch 00
198 if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
199 if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
200 hbytes overwrite data 0 $srch
201 dgram-socket transmit $udpsock $data $socktmp/$dst
203 puts stderr "$orgsrc -> $dst: $emsg"