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