chiark / gitweb /
569e7c39d9633f3d4a5d345655cd2636cbd9a877
[secnet.git] / test / invoke
1 #! /usr/bin/tclsh
2
3 package require Tclx
4
5 load chiark_tcl_hbytes-1.so
6
7 set netlink(inside) {
8     local-address "172.18.232.9";
9     secnet-address "172.18.232.10";
10     remote-networks "172.18.232.0/28";
11 }
12 set netlink(outside) {
13     local-address "172.18.232.1";
14     secnet-address "172.18.232.2";
15     remote-networks "172.18.232.0/28";
16 }
17
18 set ports(inside) {16913 16910}
19 set ports(outside) 16900
20
21 set extra(inside) {
22     local-mobile True;
23     mtu-target 1260;
24 }
25 set extra(outside) {}
26
27 proc mkconf {which} {
28     global tmp
29     global netlink
30     global ports
31     global extra
32     global netlinkfh
33     set pipefp $tmp/$which.netlink
34     foreach tr {t r} {
35         file delete $pipefp.$tr
36         exec mkfifo -m600 $pipefp.$tr
37         set netlinkfh($which.$tr) [set fh [open $pipefp.$tr r+]]
38         fconfigure $fh -blocking 0 -buffering none -translation binary
39     }
40     fileevent $netlinkfh($which.r) readable [list netlink-readable $which]
41     set fakeuf $tmp/$which.fake-userv
42     set fakeuh [open $fakeuf w 0755]
43     puts $fakeuh "#!/bin/sh
44 set -e
45 exec 3<&0
46 cat <&3 3<&- >$pipefp.r &
47 exec 3<>$pipefp.t
48 exec <$pipefp.t
49 exec 3<&-
50 exec cat
51 "
52     close $fakeuh
53     set cfg "
54         netlink userv-ipif {
55             name \"netlink\";
56             userv-path \"$fakeuf\";
57         $netlink($which)
58             mtu 1400;
59             buffer sysbuffer(2048);
60             interface \"secnet-test-[string range $which 0 0]\";
61         };
62         comm
63 "
64     set delim {}
65     foreach port $ports($which) {
66         append cfg "$delim
67             udp {
68                 port $port;
69                 buffer sysbuffer(4096);
70             }
71         "
72         set delim ,
73     }
74     append cfg ";
75         local-name \"test-example/$which/$which\";
76         local-key rsa-private(\"test-example/$which.key\");
77 "
78     append cfg $extra($which)
79     append cfg {
80         log logfile {
81             filename "/dev/tty";
82             class "info","notice","warning","error","security","fatal";
83         };
84         system {
85         };
86         resolver adns {
87         };
88         log-events "all";
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);
93     }
94     return $cfg
95 }
96
97 proc spawn-secnet {which} {
98     global netlinkfh
99     global tmp
100     upvar #0 pids($which) pid
101     set cf $tmp/$which.conf
102     set ch [open $cf w]
103     puts $ch [mkconf $which]
104     close $ch
105     set argl [list ./secnet -dvnc $cf]
106     set pid [fork]
107     if {!$pid} {
108         execl [lindex $argl 0] [lrange $argl 1 end]
109     }
110     puts -nonewline $netlinkfh($which.t) [hbytes h2raw c0]
111 }
112
113 proc netlink-readable {which} {
114     global ok
115     upvar #0 netlinkfh($which.r) fh
116     read $fh; # empty the buffer
117     switch -exact $which {
118         inside {
119             puts OK
120             set ok 1; # what a bodge
121             return
122         }
123         outside {
124             error "inside rx'd!"
125         }
126     }
127 }
128
129 proc bgerror {message} {
130     global errorInfo errorCode
131     catch {
132         puts stderr "
133 ----------------------------------------
134 $errorInfo
135
136 $errorCode
137 $message
138 ----------------------------------------
139     "
140     }
141     exit 1
142 }
143
144 proc sendpkt {} {
145     global netlinkfh
146     set p {
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
152         3435 3637
153     }
154     puts -nonewline $netlinkfh(inside.t) \
155         [hbytes h2raw c0[join $p ""]c0]
156 }
157
158 file mkdir test/tmp
159 set tmp test/tmp
160
161 spawn-secnet inside
162 spawn-secnet outside
163
164 after 500 sendpkt
165 after 1000 sendpkt
166 after 5000 timed-out
167
168 vwait ok