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