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             prefix \"$site\";
  86             class \"debug\",\"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\";
  87         };
  88     "
  89     append cfg {
  90         system {
  91         };
  92         resolver adns {
  93         };
  94         log-events "all";
  95         random randomfile("/dev/urandom",no);
  96         transform eax-serpent { }, serpent256-cbc { };
  97     }
  98
  99     set f [open $builddir/test-example/sites.conf r]
 100     set sites [read $f]
 101     close $f
 102     append cfg $sites
 103     append cfg {
 104         sites map(site,all-sites);
 105     }
 106     return $cfg
 107 }
 108
 109 proc spawn-secnet {location site} {
 110     global tmp
 111     global builddir
 112     global netlinkfh
 113     global env
 114     upvar #0 pids($site) pid
 115     set cf $tmp/$site.conf
 116     set ch [open $cf w]
 117     puts $ch [mkconf $location $site]
 118     close $ch
 119     set argl [list $builddir/secnet -dvnc $cf]
 120     puts -nonewline "spawn"
 121     foreach k [array names env] {
 122         switch -glob $k {
 123             SECNET_TEST_BUILDDIR { }
 124             *SECNET* -
 125             *PRELOAD* { puts -nonewline " $k=$env($k)" }
 126         }
 127     }
 128     puts " $argl"
 129     set pid [fork]
 130     if {!$pid} {
 131         execl [lindex $argl 0] [lrange $argl 1 end]
 132     }
 133     puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
 134 }
 135
 136 proc netlink-readable {location site} {
 137     global ok
 138     upvar #0 netlinkfh($site.r) fh
 139     read $fh; # empty the buffer
 140     switch -exact $site {
 141         inside {
 142             puts OK
 143             set ok 1; # what a bodge
 144             return
 145         }
 146         outside {
 147             error "inside rx'd!"
 148         }
 149     }
 150 }
 151
 152 proc bgerror {message} {
 153     global errorInfo errorCode
 154     catch {
 155         puts stderr "
 156 ----------------------------------------
 157 $errorInfo
 158
 159 $errorCode
 160 $message
 161 ----------------------------------------
 162     "
 163     }
 164     exit 1
 165 }
 166
 167 proc sendpkt {} {
 168     global netlinkfh
 169     set p {
 170         4500 0054 ed9d 4000 4001 24da ac12 e809
 171         ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
 172         0000 0000 507f 0b00 0000 0000 1011 1213
 173         1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
 174         2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
 175         3435 3637
 176     }
 177     puts -nonewline $netlinkfh(inside.t) \
 178         [hbytes h2raw c0[join $p ""]c0]
 179 }
 180
 181 set socktmp $tmp/s
 182 exec mkdir -p -m700 $socktmp
 183 regsub {^(?!/)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
 184
 185 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
 186
 187 set env(UDP_PRELOAD_DIR) $socktmp
 188 prefix_preload $builddir/stest/udp-preload.so
 189
 190 proc udp-proxy {} {
 191     global socktmp udpsock
 192     set u $socktmp/udp
 193     file delete $u
 194     regsub {^(?!/)} $u {./} u
 195     set udpsock [dgram-socket create $u]
 196     dgram-socket on-receive $udpsock udp-relay
 197 }
 198
 199 proc udp-relay {data src sock args} {
 200     global udpsock socktmp
 201     set headerlen [expr {52+1}]
 202     set orgsrc $src
 203
 204     set dst [hbytes range $data 0 $headerlen]
 205     regsub {(?:00)*$} $dst {} dst
 206     set dst [hbytes h2raw $dst]
 207
 208     hbytes overwrite data 0 [hbytes zeroes $headerlen]
 209     regsub {.*/} $src {} src
 210     set srch [hbytes raw2h $src]
 211     hbytes append srch 00
 212     if {[catch {
 213         if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
 214         if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
 215         hbytes overwrite data 0 $srch
 216         dgram-socket transmit $udpsock $data $socktmp/$dst
 217     } emsg]} {
 218         puts stderr "$orgsrc -> $dst: $emsg"
 219     }
 220 }
 221
 222 proc test-kex {} {
 223     udp-proxy
 224     spawn-secnet in inside
 225     spawn-secnet out outside
 226
 227     after 500 sendpkt
 228     after 1000 sendpkt
 229     after 5000 timed-out
 230
 231     vwait ok
 232 }