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 set privkey(inside) test-example/inside.privkeys/
  29 set privkey(outside) test-example/outside.privkeys/
  30
  31 set initiator inside
  32
  33 proc sitesconf_hook {l} { return $l }
  34
  35 proc oldsecnet {site} {
  36     upvar #0 oldsecnet($site) oldsecnet
  37     expr {[info exists oldsecnet] && [set oldsecnet]}
  38 }
  39
  40 proc mkconf {location site} {
  41     global tmp
  42     global builddir
  43     global netlink
  44     global ports
  45     global extra
  46     global netlinkfh
  47     upvar #0 privkey($site) privkey
  48     set pipefp $tmp/$site.netlink
  49     foreach tr {t r} {
  50         file delete $pipefp.$tr
  51         exec mkfifo -m600 $pipefp.$tr
  52         set netlinkfh($site.$tr) [set fh [open $pipefp.$tr r+]]
  53         fconfigure $fh -blocking 0 -buffering none -translation binary
  54     }
  55     fileevent $netlinkfh($site.r) readable \
  56         [list netlink-readable $location $site]
  57     set fakeuf $tmp/$site.fake-userv
  58     set fakeuh [open $fakeuf w 0755]
  59     puts $fakeuh "#!/bin/sh
  60 set -e
  61 exec 3<&0
  62 cat <&3 3<&- >$pipefp.r &
  63 exec 3<>$pipefp.t
  64 exec <$pipefp.t
  65 exec 3<&-
  66 exec cat
  67 "
  68     close $fakeuh
  69     set cfg "
  70         hash sha1;
  71         netlink userv-ipif {
  72             name \"netlink\";
  73             userv-path \"$fakeuf\";
  74         $netlink($site)
  75             mtu 1400;
  76             buffer sysbuffer(2048);
  77             interface \"secnet-test-[string range $site 0 0]\";
  78         };
  79         comm
  80 "
  81     set delim {}
  82     foreach port $ports($site) {
  83         append cfg "$delim
  84             udp {
  85                 port $port;
  86                 address \"::1\", \"127.0.0.1\";
  87                 buffer sysbuffer(4096);
  88             }
  89         "
  90         set delim ,
  91     }
  92     append cfg ";
  93         local-name \"test-example/$location/$site\";
  94 "
  95     switch -glob $privkey {
  96         */ {
  97             set sitesconf sites.conf
  98             append cfg "
  99                 key-cache priv-cache({
 100                     privkeys \"$builddir/${privkey}priv.\";
 101                 });
 102 "
 103         }
 104         * {
 105             set sitesconf sites-nonego.conf
 106             append cfg "
 107                 local-key rsa-private(\"$builddir/$privkey\");
 108 "
 109         }
 110     }
 111     set sitesconf $builddir/test-example/$sitesconf
 112
 113     append cfg $extra($site)
 114     append cfg "
 115         log logfile {
 116             prefix \"$site\";
 117             class \"debug\",\"info\",\"notice\",\"warning\",\"error\",\"security\",\"fatal\";
 118     "
 119     if {[oldsecnet $site]} { append cfg "
 120             filename \"/dev/stderr\";
 121     " }
 122     append cfg "
 123         };
 124     "
 125     append cfg {
 126         system {
 127         };
 128         resolver adns {
 129         };
 130         log-events "all";
 131         random randomfile("/dev/urandom",no);
 132         transform eax-serpent { }, serpent256-cbc { };
 133     }
 134
 135     set pubkeys $tmp/$site.pubkeys
 136     file delete -force $pubkeys
 137     exec cp -rl $builddir/test-example/pubkeys $pubkeys
 138
 139     set f [open $sitesconf r]
 140     while {[gets $f l] >= 0} {
 141         regsub {\"[^\"]*test-example/pubkeys/} $l "\"$pubkeys/" l
 142         set l [sitesconf_hook $l]
 143         append cfg $l "\n"
 144     }
 145     set sites [read $f]
 146     close $f
 147     append cfg $sites
 148     append cfg {
 149         sites map(site,all-sites);
 150     }
 151
 152     return $cfg
 153 }
 154
 155 proc spawn-secnet {location site} {
 156     global tmp
 157     global builddir
 158     global netlinkfh
 159     global env
 160     global pidmap
 161     global readbuf
 162     upvar #0 pids($site) pid
 163     set readbuf($site) {}
 164     set cf $tmp/$site.conf
 165     set ch [open $cf w]
 166     puts $ch [mkconf $location $site]
 167     close $ch
 168     set secnet $builddir/secnet
 169     if {[oldsecnet $site]} {
 170         set secnet $env(OLD_SECNET_DIR)/secnet
 171     }
 172     set argl [list $secnet -dvnc $cf]
 173     set divertk SECNET_STEST_DIVERT_$site
 174     puts -nonewline "spawn"
 175     foreach k [array names env] {
 176         switch -glob $k {
 177             SECNET_STEST_DIVERT_* -
 178             SECNET_TEST_BUILDDIR - OLD_SECNET_DIR { }
 179             *SECNET* -
 180             *PRELOAD* { puts -nonewline " $k=$env($k)" }
 181         }
 182     }
 183     puts " $argl"
 184     if {[info exists env($divertk)]} {
 185         switch -glob $env($divertk) {
 186             i {
 187                 puts -nonewline "run ^ command, hit return "
 188                 flush stdout
 189                 gets stdin
 190                 set argl {}
 191             }
 192             0 - "" {
 193             }
 194             * {
 195                 set argl [split $env($divertk)]
 196             }
 197         }
 198     }
 199     if {[llength $argl]} {
 200         set pid [fork]
 201         set pidmap($pid) "secnet $location/$site"
 202         if {!$pid} {
 203             execl [lindex $argl 0] [lrange $argl 1 end]
 204         }
 205     }
 206     puts -nonewline $netlinkfh($site.t) [hbytes h2raw c0]
 207 }
 208
 209 proc netlink-readable {location site} {
 210     global ok
 211     upvar #0 readbuf($site) buf
 212     upvar #0 netlinkfh($site.r) fh
 213     while 1 {
 214         set x [read $fh]
 215         set h [hbytes raw2h $x]
 216         if {![hbytes length $h]} return
 217         append buf $h
 218         #puts "READABLE $site buf=$buf"
 219         while {[regexp {^((?:..)*?)c0(.*)$} $buf dummy now buf]} {
 220             #puts "READABLE $site now=$now (buf=$buf)"
 221             regsub -all {^((?:..)*?)dbdc} $now {\1c0} now
 222             regsub -all {^((?:..)*?)dbdd} $now {\1db} now
 223             puts "netlink-got-packet $location $site $now"
 224             netlink-got-packet $location $site $now
 225         }
 226     }
 227 }
 228
 229 proc netlink-got-packet {location site data} {
 230     global initiator
 231     if {![hbytes length $data]} return
 232     switch -exact $site!$initiator {
 233         inside!inside - outside!outside {
 234             switch -glob $data {
 235                 45000054ed9d4000fe0166d9ac12e802ac12e80900* {
 236                     puts "OK $data"
 237                     finish 0
 238                 }
 239                 * {
 240                     error "unexpected $site $data"
 241                 }
 242             }
 243         }
 244         default {
 245             error "$site rx'd! (initiator $initiator)"
 246         }
 247     }
 248 }
 249
 250 proc bgerror {message} {
 251     global errorInfo errorCode
 252     catch {
 253         puts stderr "
 254 ----------------------------------------
 255 $errorInfo
 256
 257 $errorCode
 258 $message
 259 ----------------------------------------
 260     "
 261     }
 262     finish 1
 263 }
 264
 265 proc sendpkt {} {
 266     global netlinkfh
 267     global initiator
 268     set p {
 269         4500 0054 ed9d 4000 4001 24da ac12 e809
 270         ac12 e802 0800 1de4 2d96 0001 f1d4 a05d
 271         0000 0000 507f 0b00 0000 0000 1011 1213
 272         1415 1617 1819 1a1b 1c1d 1e1f 2021 2223
 273         2425 2627 2829 2a2b 2c2d 2e2f 3031 3233
 274         3435 3637
 275     }
 276     puts -nonewline $netlinkfh($initiator.t) \
 277         [hbytes h2raw c0[join $p ""]c0]
 278 }
 279
 280 set socktmp $tmp/s
 281 exec mkdir -p -m700 $socktmp
 282 regsub {^(?!/|\./)} $socktmp {./} socktmp ;# dgram-socket wants ./ or /
 283
 284 proc prefix_preload {lib} { prefix_some_path LD_PRELOAD $lib }
 285
 286 set env(UDP_PRELOAD_DIR) $socktmp
 287 prefix_preload $builddir/stest/udp-preload.so
 288
 289 proc finish {estatus} {
 290     puts stderr "FINISHING $estatus"
 291     signal default SIGCHLD
 292     global pidmap
 293     foreach pid [array names pidmap] {
 294         kill KILL $pid
 295     }
 296     exit $estatus
 297 }
 298
 299 proc reap {} {
 300     global pidmap
 301     #puts stderr REAPING
 302     foreach pid [array names pidmap] {
 303         set got [wait -nohang $pid]
 304         if {![llength $got]} continue
 305         set info $pidmap($pid)
 306         unset pidmap($pid)
 307         puts stderr "reaped $info: $got"
 308         finish 1
 309     }
 310 }
 311
 312 signal -restart trap SIGCHLD { after idle reap }
 313
 314 proc udp-proxy {} {
 315     global socktmp udpsock
 316     set u $socktmp/udp
 317     file delete $u
 318     regsub {^(?!/)} $u {./} u
 319     set udpsock [dgram-socket create $u]
 320     dgram-socket on-receive $udpsock udp-relay
 321 }
 322
 323 proc udp-relay {data src sock args} {
 324     global udpsock socktmp
 325     set headerlen [expr {52+1}]
 326     set orgsrc $src
 327
 328     set dst [hbytes range $data 0 $headerlen]
 329     regsub {(?:00)*$} $dst {} dst
 330     set dst [hbytes h2raw $dst]
 331
 332     hbytes overwrite data 0 [hbytes zeroes $headerlen]
 333     regsub {.*/} $src {} src
 334     set srch [hbytes raw2h $src]
 335     hbytes append srch 00
 336     if {[catch {
 337         if {[regexp {[^.,:0-9a-f]} $dst c]} { error "bad dst" }
 338         if {[hbytes length $srch] > $headerlen} { error "src addr too long" }
 339         hbytes overwrite data 0 $srch
 340         dgram-socket transmit $udpsock $data $socktmp/$dst
 341     } emsg]} {
 342         puts stderr "$orgsrc -> $dst: $emsg"
 343     }
 344 }
 345
 346 proc test-kex {} {
 347     udp-proxy
 348     spawn-secnet in inside
 349     spawn-secnet out outside
 350
 351     after 500 sendpkt
 352     after 1000 sendpkt
 353     after 5000 timed-out
 354
 355     vwait ok
 356 }