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     global pidmap
 115     upvar #0 pids($site) pid
 116     set cf $tmp/$site.conf
 117     set ch [open $cf w]
 118     puts $ch [mkconf $location $site]
 119     close $ch
 120     set argl [list $builddir/secnet -dvnc $cf]
 121     set divertk SECNET_STEST_DIVERT_$site
 122     puts -nonewline "spawn"
 123     foreach k [array names env] {
 124         switch -glob $k {
 125             SECNET_STEST_DIVERT_* -
 126             SECNET_TEST_BUILDDIR { }
 127             *SECNET* -
 128             *PRELOAD* { puts -nonewline " $k=$env($k)" }
 129         }
 130     }
 131     puts " $argl"
 132     if {[info exists env($divertk)]} {
 133         switch -glob $env($divertk) {
 134             i {
 135                 puts -nonewline "run ^ command, hit return "
 136                 flush stdout
 137                 gets stdin
 138                 set argl {}
 139             }
 140             0 - "" {
 141             }
 142             * {
 143                 set argl [split $env($divertk)]
 144             }
 145         }
 146     }
 147     if {[llength $argl]} {
 148         set pid [fork]
 149         set pidmap($pid) "secnet $location/$site"
 150         if {!$pid} {
 151             execl [lindex $argl 0] [lrange $argl 1 end]
 152         }
 153     }
 154     puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
 155 }
 156
 157 proc netlink-readable {location site} {
 158     global ok
 159     upvar #0 netlinkfh($site.r) fh
 160     read $fh; # empty the buffer
 161     switch -exact $site {
 162         inside {
 163             puts OK
 164             finish 0
 165         }
 166         outside {
 167             error "inside rx'd!"
 168         }
 169     }
 170 }
 171
 172 proc bgerror {message} {
 173     global errorInfo errorCode
 174     catch {
 175         puts stderr "
 176 ----------------------------------------
 177 $errorInfo
 178
 179 $errorCode
 180 $message
 181 ----------------------------------------
 182     "
 183     }
 184     finish 1
 185 }
 186
 187 proc sendpkt {} {
 188     global netlinkfh
 189     set p {
 190         4500 0054 ed9d 4000 4001 24da ac12 e809
 191         ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
 192         0000 0000 507f 0b00 0000 0000 1011 1213
 193         1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
 194         2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
 195         3435 3637
 196     }
 197     puts -nonewline $netlinkfh(inside.t) \
 198         [hbytes h2raw c0[join $p ""]c0]
 199 }
 200
 201 set socktmp $tmp/s
 202 exec mkdir -p -m700 $socktmp
 203 regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
 204
 205 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
 206
 207 set env(UDP_PRELOAD_DIR) $socktmp
 208 prefix_preload $builddir/stest/udp-preload.so
 209
 210 proc finish {estatus} {
 211     puts stderr "FINISHING $estatus"
 212     signal default SIGCHLD
 213     global pidmap
 214     foreach pid [array names pidmap] {
 215         kill KILL $pid
 216     }
 217     exit $estatus
 218 }
 219
 220 proc reap {} {
 221     global pidmap
 222     #puts stderr REAPING
 223     foreach pid [array names pidmap] {
 224         set got [wait -nohang $pid]
 225         if {![llength $got]} continue
 226         set info $pidmap($pid)
 227         unset pidmap($pid)
 228         puts stderr "reaped $info: $got"
 229         finish 1
 230     }
 231 }
 232
 233 signal -restart trap SIGCHLD { after idle reap }
 234
 235 proc udp-proxy {} {
 236     global socktmp udpsock
 237     set u $socktmp/udp
 238     file delete $u
 239     regsub {^(?!/)} $u {./} u
 240     set udpsock [dgram-socket create $u]
 241     dgram-socket on-receive $udpsock udp-relay
 242 }
 243
 244 proc udp-relay {data src sock args} {
 245     global udpsock socktmp
 246     set headerlen [expr {52+1}]
 247     set orgsrc $src
 248
 249     set dst [hbytes range $data 0 $headerlen]
 250     regsub {(?:00)*$} $dst {} dst
 251     set dst [hbytes h2raw $dst]
 252
 253     hbytes overwrite data 0 [hbytes zeroes $headerlen]
 254     regsub {.*/} $src {} src
 255     set srch [hbytes raw2h $src]
 256     hbytes append srch 00
 257     if {[catch {
 258         if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
 259         if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
 260         hbytes overwrite data 0 $srch
 261         dgram-socket transmit $udpsock $data $socktmp/$dst
 262     } emsg]} {
 263         puts stderr "$orgsrc -> $dst: $emsg"
 264     }
 265 }
 266
 267 proc test-kex {} {
 268     udp-proxy
 269     spawn-secnet in inside
 270     spawn-secnet out outside
 271
 272     after 500 sendpkt
 273     after 1000 sendpkt
 274     after 5000 timed-out
 275
 276     vwait ok
 277 }