stest/common.tcl

   1 source test-common.tcl
   2
   3 package require Tclx
   4
   5 load chiark_tcl_hbytes-1.so
   6 load chiark_tcl_dgram-1.so
   7
   8 set netlink(inside) {
   9     local-address "172.18.232.9";
  10     secnet-address "172.18.232.10";
  11     remote-networks "172.18.232.0/28";
  12 }
  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";
  17 }
  18
  19 set ports(inside) {16913 16910}
  20 set ports(outside) 16900
  21
  22 set extra(inside) {
  23     local-mobile True;
  24     mtu-target 1260;
  25 }
  26 set extra(outside) {}
  27
  28 proc mkconf {location site} {
  29     global tmp
  30     global builddir
  31     global netlink
  32     global ports
  33     global extra
  34     global netlinkfh
  35     set pipefp $tmp/$site.netlink
  36     foreach tr {t r} {
  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
  41     }
  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
  47 set -e
  48 exec 3<&0
  49 cat <&3 3<&- >$pipefp.r &
  50 exec 3<>$pipefp.t
  51 exec <$pipefp.t
  52 exec 3<&-
  53 exec cat
  54 "
  55     close $fakeuh
  56     set cfg "
  57         netlink userv-ipif {
  58             name \"netlink\";
  59             userv-path \"$fakeuf\";
  60         $netlink($site)
  61             mtu 1400;
  62             buffer sysbuffer(2048);
  63             interface \"secnet-test-[string range $site 0 0]\";
  64         };
  65         comm
  66 "
  67     set delim {}
  68     foreach port $ports($site) {
  69         append cfg "$delim
  70             udp {
  71                 port $port;
  72                 address \"::1\", \"127.0.0.1\";
  73                 buffer sysbuffer(4096);
  74             }
  75         "
  76         set delim ,
  77     }
  78     append cfg ";
  79         local-name \"test-example/$location/$site\";
  80         local-key rsa-private(\"$builddir/test-example/$site.key\");
  81 "
  82     append cfg $extra($site)
  83     append cfg {
  84         log logfile {
  85             filename "/dev/tty";
  86             class "info","notice","warning","error","security","fatal";
  87         };
  88         system {
  89         };
  90         resolver adns {
  91         };
  92         log-events "all";
  93         random randomfile("/dev/urandom",no);
  94         transform eax-serpent { }, serpent256-cbc { };
  95     }
  96
  97     set f [open $builddir/test-example/sites.conf r]
  98     set sites [read $f]
  99     close $f
 100     append cfg $sites
 101     append cfg {
 102         sites map(site,all-sites);
 103     }
 104     return $cfg
 105 }
 106
 107 proc spawn-secnet {location site} {
 108     global tmp
 109     global builddir
 110     global netlinkfh
 111     upvar #0 pids($site) pid
 112     set cf $tmp/$site.conf
 113     set ch [open $cf w]
 114     puts $ch [mkconf $location $site]
 115     close $ch
 116     set argl [list $builddir/secnet -dvnc $cf]
 117     set pid [fork]
 118     if {!$pid} {
 119         execl [lindex $argl 0] [lrange $argl 1 end]
 120     }
 121     puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
 122 }
 123
 124 proc netlink-readable {location site} {
 125     global ok
 126     upvar #0 netlinkfh($site.r) fh
 127     read $fh; # empty the buffer
 128     switch -exact $site {
 129         inside {
 130             puts OK
 131             set ok 1; # what a bodge
 132             return
 133         }
 134         outside {
 135             error "inside rx'd!"
 136         }
 137     }
 138 }
 139
 140 proc bgerror {message} {
 141     global errorInfo errorCode
 142     catch {
 143         puts stderr "
 144 ----------------------------------------
 145 $errorInfo
 146
 147 $errorCode
 148 $message
 149 ----------------------------------------
 150     "
 151     }
 152     exit 1
 153 }
 154
 155 proc sendpkt {} {
 156     global netlinkfh
 157     set p {
 158         4500 0054 ed9d 4000 4001 24da ac12 e809
 159         ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
 160         0000 0000 507f 0b00 0000 0000 1011 1213
 161         1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
 162         2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
 163         3435 3637
 164     }
 165     puts -nonewline $netlinkfh(inside.t) \
 166         [hbytes h2raw c0[join $p ""]c0]
 167 }
 168
 169 set socktmp $tmp/s
 170 exec mkdir -p -m700 $socktmp
 171 regsub {^(?!/)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
 172
 173 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
 174
 175 set env(UDP_PRELOAD_DIR) $socktmp
 176 prefix_preload $builddir/stest/udp-preload.so
 177
 178 proc udp-proxy {} {
 179     global socktmp udpsock
 180     set u $socktmp/udp
 181     file delete $u
 182     regsub {^(?!/)} $u {./} u
 183     set udpsock [dgram-socket create $u]
 184     dgram-socket on-receive $udpsock udp-relay
 185 }
 186
 187 proc udp-relay {data src sock args} {
 188     global udpsock socktmp
 189     set headerlen [expr {52+1}]
 190     set orgsrc $src
 191
 192     set dst [hbytes range $data 0 $headerlen]
 193     regsub {(?:00)*$} $dst {} dst
 194     set dst [hbytes h2raw $dst]
 195
 196     hbytes overwrite data 0 [hbytes zeroes $headerlen]
 197     regsub {.*/} $src {} src
 198     set srch [hbytes raw2h $src]
 199     hbytes append srch 00
 200     if {[catch {
 201         if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
 202         if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
 203         hbytes overwrite data 0 $srch
 204         dgram-socket transmit $udpsock $data $socktmp/$dst
 205     } emsg]} {
 206         puts stderr "$orgsrc -> $dst: $emsg"
 207     }
 208 }
 209
 210 proc test-kex {} {
 211     udp-proxy
 212     spawn-secnet in inside
 213     spawn-secnet out outside
 214
 215     after 500 sendpkt
 216     after 1000 sendpkt
 217     after 5000 timed-out
 218
 219     vwait ok
 220 }