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