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