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