Artifact
4d694417ae639e0f08d0c8ccde795431fa5ccdd53e6117580ea126ef25bd9d6c:
0000: 23 21 2f 62 69 6e 2f 73 68 0a 23 20 54 68 65 20 #!/bin/sh.# The
0010: 6e 65 78 74 20 6c 69 6e 65 20 69 73 20 65 78 65 next line is exe
0020: 63 75 74 65 64 20 62 79 20 2f 62 69 6e 2f 73 68 cuted by /bin/sh
0030: 2c 20 62 75 74 20 6e 6f 74 20 74 63 6c 20 5c 0a , but not tcl \.
0040: 65 78 65 63 20 74 63 6c 73 68 20 22 24 30 22 20 exec tclsh "$0"
0050: 24 7b 31 2b 22 24 40 22 7d 0a 0a 70 61 63 6b 61 ${1+"$@"}..packa
0060: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 0a ge require tls..
0070: 73 65 74 20 64 69 72 09 09 09 5b 66 69 6c 65 20 set dir...[file
0080: 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61 join [file dirna
0090: 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d me [info script]
00a0: 5d 20 2e 2e 2f 74 65 73 74 73 2f 63 65 72 74 73 ] ../tests/certs
00b0: 5d 0a 73 65 74 20 4f 50 54 53 28 2d 63 61 66 69 ].set OPTS(-cafi
00c0: 6c 65 29 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 le).[file join $
00d0: 64 69 72 20 63 61 2e 70 65 6d 5d 0a 73 65 74 20 dir ca.pem].set
00e0: 4f 50 54 53 28 2d 63 65 72 74 29 09 09 5b 66 69 OPTS(-cert)..[fi
00f0: 6c 65 20 6a 6f 69 6e 20 24 64 69 72 20 63 6c 69 le join $dir cli
0100: 65 6e 74 2e 70 65 6d 5d 0a 73 65 74 20 4f 50 54 ent.pem].set OPT
0110: 53 28 2d 6b 65 79 29 09 09 5b 66 69 6c 65 20 6a S(-key)..[file j
0120: 6f 69 6e 20 24 64 69 72 20 63 6c 69 65 6e 74 2e oin $dir client.
0130: 6b 65 79 5d 0a 0a 73 65 74 20 4f 50 54 53 28 2d key]..set OPTS(-
0140: 68 6f 73 74 29 09 09 6c 6f 72 61 78 0a 73 65 74 host)..lorax.set
0150: 20 4f 50 54 53 28 2d 70 6f 72 74 29 09 09 32 34 OPTS(-port)..24
0160: 36 38 0a 73 65 74 20 4f 50 54 53 28 2d 64 65 62 68.set OPTS(-deb
0170: 75 67 29 09 31 0a 73 65 74 20 4f 50 54 53 28 2d ug).1.set OPTS(-
0180: 63 6f 75 6e 74 29 09 38 0a 73 65 74 20 4f 50 54 count).8.set OPT
0190: 53 28 2d 70 61 72 61 6c 6c 65 6c 29 09 31 0a 0a S(-parallel).1..
01a0: 66 6f 72 65 61 63 68 20 7b 6b 65 79 20 76 61 6c foreach {key val
01b0: 7d 20 24 61 72 67 76 20 7b 0a 20 20 20 20 69 66 } $argv {. if
01c0: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
01d0: 4f 50 54 53 28 24 6b 65 79 29 5d 7d 20 7b 0a 09 OPTS($key)]} {..
01e0: 70 75 74 73 20 73 74 64 65 72 72 20 22 55 73 61 puts stderr "Usa
01f0: 67 65 3a 20 24 61 72 67 76 30 20 3f 6f 70 74 69 ge: $argv0 ?opti
0200: 6f 6e 73 3f 5c 0a 09 09 5c 6e 5c 74 2d 64 65 62 ons?\...\n\t-deb
0210: 75 67 20 20 20 20 20 62 6f 6f 6c 65 61 6e 20 20 ug boolean
0220: 20 44 65 62 75 67 67 69 6e 67 20 6f 6e 20 6f 72 Debugging on or
0230: 20 6f 66 66 20 28 24 4f 50 54 53 28 2d 64 65 62 off ($OPTS(-deb
0240: 75 67 29 29 5c 0a 09 09 5c 6e 5c 74 2d 63 61 66 ug))\...\n\t-caf
0250: 69 6c 65 20 20 20 20 66 69 6c 65 20 20 20 20 20 ile file
0260: 20 43 65 72 74 2e 20 41 75 74 68 2e 20 46 69 6c Cert. Auth. Fil
0270: 65 20 28 24 4f 50 54 53 28 2d 63 61 66 69 6c 65 e ($OPTS(-cafile
0280: 29 29 5c 0a 09 09 5c 6e 5c 74 2d 63 6c 69 65 6e ))\...\n\t-clien
0290: 74 20 20 20 20 66 69 6c 65 20 20 20 20 20 20 43 t file C
02a0: 6c 69 65 6e 74 20 43 65 72 74 20 28 24 4f 50 54 lient Cert ($OPT
02b0: 53 28 2d 63 65 72 74 29 29 5c 0a 09 09 5c 6e 5c S(-cert))\...\n\
02c0: 74 2d 63 6b 65 79 20 20 20 20 20 20 66 69 6c 65 t-ckey file
02d0: 20 20 20 20 20 20 43 6c 69 65 6e 74 20 4b 65 79 Client Key
02e0: 20 28 24 4f 50 54 53 28 2d 6b 65 79 29 29 5c 0a ($OPTS(-key))\.
02f0: 09 09 5c 6e 5c 74 2d 63 6f 75 6e 74 20 20 20 20 ..\n\t-count
0300: 20 6e 75 6d 20 20 20 20 20 20 20 4e 6f 20 6f 66 num No of
0310: 20 73 79 6e 63 2e 20 63 6f 6e 6e 65 63 74 69 6f sync. connectio
0320: 6e 73 20 74 6f 20 6d 61 6b 65 20 70 65 72 20 63 ns to make per c
0330: 6c 69 65 6e 74 20 28 24 4f 50 54 53 28 2d 63 6f lient ($OPTS(-co
0340: 75 6e 74 29 29 5c 0a 09 09 5c 6e 5c 74 2d 70 61 unt))\...\n\t-pa
0350: 72 61 6c 6c 65 6c 20 20 6e 75 6d 20 20 20 20 20 rallel num
0360: 20 20 4e 6f 20 6f 66 20 70 61 72 61 6c 6c 65 6c No of parallel
0370: 20 63 6c 69 65 6e 74 73 20 74 6f 20 72 75 6e 20 clients to run
0380: 28 24 4f 50 54 53 28 2d 70 61 72 61 6c 6c 65 6c ($OPTS(-parallel
0390: 29 29 5c 0a 09 09 5c 6e 5c 74 2d 68 6f 73 74 20 ))\...\n\t-host
03a0: 20 20 20 20 20 68 6f 73 74 6e 61 6d 65 20 20 53 hostname S
03b0: 65 72 76 65 72 20 68 6f 73 74 6e 61 6d 65 20 28 erver hostname (
03c0: 24 4f 50 54 53 28 2d 68 6f 73 74 29 29 5c 0a 09 $OPTS(-host))\..
03d0: 09 5c 6e 5c 74 2d 70 6f 72 74 20 20 20 20 20 20 .\n\t-port
03e0: 6e 75 6d 20 20 20 20 20 20 20 53 65 72 76 65 72 num Server
03f0: 20 70 6f 72 74 20 28 24 4f 50 54 53 28 2d 70 6f port ($OPTS(-po
0400: 72 74 29 29 22 0a 09 65 78 69 74 0a 20 20 20 20 rt))"..exit.
0410: 7d 0a 20 20 20 20 73 65 74 20 4f 50 54 53 28 24 }. set OPTS($
0420: 6b 65 79 29 20 24 76 61 6c 0a 7d 0a 0a 69 66 20 key) $val.}..if
0430: 7b 24 4f 50 54 53 28 2d 70 61 72 61 6c 6c 65 6c {$OPTS(-parallel
0440: 29 20 3e 20 31 7d 20 7b 0a 20 20 20 20 23 20 49 ) > 1} {. # I
0450: 66 20 74 68 65 79 20 77 61 6e 74 65 64 20 70 61 f they wanted pa
0460: 72 61 6c 6c 65 6c 2c 20 77 65 20 6a 75 73 74 20 rallel, we just
0470: 73 70 61 77 6e 20 6f 75 72 73 65 6c 76 65 73 20 spawn ourselves
0480: 73 65 76 65 72 61 6c 20 74 69 6d 65 73 0a 20 20 several times.
0490: 20 20 23 20 77 69 74 68 20 74 68 65 20 72 69 67 # with the rig
04a0: 68 74 20 61 72 67 73 2e 0a 0a 20 20 20 20 73 65 ht args... se
04b0: 74 20 63 6d 64 09 5b 69 6e 66 6f 20 6e 61 6d 65 t cmd.[info name
04c0: 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 0a 20 20 ofexecutable].
04d0: 20 20 73 65 74 20 73 63 72 69 70 74 09 5b 69 6e set script.[in
04e0: 66 6f 20 73 63 72 69 70 74 5d 0a 20 20 20 20 66 fo script]. f
04f0: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
0500: 20 3c 20 24 4f 50 54 53 28 2d 70 61 72 61 6c 6c < $OPTS(-parall
0510: 65 6c 29 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a el)} {incr i} {.
0520: 09 65 76 61 6c 20 5b 6c 69 73 74 20 65 78 65 63 .eval [list exec
0530: 20 24 63 6d 64 20 24 73 63 72 69 70 74 5d 20 5b $cmd $script] [
0540: 61 72 72 61 79 20 67 65 74 20 4f 50 54 53 5d 20 array get OPTS]
0550: 5b 6c 69 73 74 20 2d 70 61 72 61 6c 6c 65 6c 20 [list -parallel
0560: 30 5d 20 26 0a 20 20 20 20 7d 0a 20 20 20 20 65 0] &. }. e
0570: 78 69 74 0a 7d 0a 0a 23 20 4c 6f 63 61 6c 20 68 xit.}..# Local h
0580: 61 6e 64 6c 65 72 20 66 6f 72 20 61 6e 79 20 62 andler for any b
0590: 61 63 6b 67 72 6f 75 6e 64 20 65 72 72 6f 72 73 ackground errors
05a0: 2e 0a 70 72 6f 63 20 62 67 65 72 72 6f 72 20 7b ..proc bgerror {
05b0: 6d 73 67 7d 20 7b 20 70 75 74 73 20 22 42 47 45 msg} { puts "BGE
05c0: 52 52 4f 52 3a 20 24 6d 73 67 22 20 7d 0a 0a 23 RROR: $msg" }..#
05d0: 20 64 65 62 75 67 67 69 6e 67 20 68 65 6c 70 65 debugging helpe
05e0: 72 20 63 6f 64 65 0a 70 72 6f 63 20 73 68 6f 72 r code.proc shor
05f0: 74 73 74 72 20 7b 73 74 72 7d 20 7b 0a 20 20 20 tstr {str} {.
0600: 20 72 65 74 75 72 6e 20 22 5b 73 74 72 69 6e 67 return "[string
0610: 20 72 65 70 6c 61 63 65 20 24 73 74 72 20 31 30 replace $str 10
0620: 20 65 6e 64 20 2e 2e 2e 5d 20 5b 73 74 72 69 6e end ...] [strin
0630: 67 20 6c 65 6e 67 74 68 20 24 73 74 72 5d 62 22 g length $str]b"
0640: 0a 7d 0a 70 72 6f 63 20 64 70 75 74 73 20 7b 6d .}.proc dputs {m
0650: 73 67 7d 20 7b 20 69 66 20 7b 24 3a 3a 4f 50 54 sg} { if {$::OPT
0660: 53 28 2d 64 65 62 75 67 29 7d 20 7b 20 70 75 74 S(-debug)} { put
0670: 73 20 73 74 64 65 72 72 20 24 6d 73 67 20 3b 20 s stderr $msg ;
0680: 66 6c 75 73 68 20 73 74 64 65 72 72 20 7d 20 7d flush stderr } }
0690: 0a 0a 73 65 74 20 4f 50 54 53 28 6f 70 65 6e 70 ..set OPTS(openp
06a0: 6f 72 74 73 29 09 30 0a 0a 23 20 44 65 66 69 6e orts).0..# Defin
06b0: 65 20 77 68 61 74 20 77 65 20 77 61 6e 74 20 74 e what we want t
06c0: 6f 20 66 65 65 64 20 64 6f 77 6e 20 74 68 65 20 o feed down the
06d0: 70 69 70 65 0a 73 65 74 20 6d 65 67 61 64 61 74 pipe.set megadat
06e0: 61 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 a [string repeat
06f0: 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 [string repeat
0700: 41 20 37 36 5d 5c 6e 20 31 30 30 30 5d 0a 0a 70 A 76]\n 1000]..p
0710: 72 6f 63 20 64 72 61 69 6e 20 7b 63 68 61 6e 7d roc drain {chan}
0720: 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c 20 4f 50 {. global OP
0730: 54 53 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 TS. if {[catc
0740: 68 20 7b 72 65 61 64 20 24 63 68 61 6e 7d 20 64 h {read $chan} d
0750: 61 74 61 5d 7d 20 7b 0a 09 23 64 70 75 74 73 20 ata]} {..#dputs
0760: 22 45 4f 46 20 24 63 68 61 6e 20 28 5b 73 68 6f "EOF $chan ([sho
0770: 72 74 73 74 72 20 24 64 61 74 61 5d 29 22 0a 09 rtstr $data])"..
0780: 69 6e 63 72 20 4f 50 54 53 28 6f 70 65 6e 70 6f incr OPTS(openpo
0790: 72 74 73 29 20 2d 31 0a 09 63 61 74 63 68 20 7b rts) -1..catch {
07a0: 63 6c 6f 73 65 20 24 63 68 61 6e 7d 0a 09 72 65 close $chan}..re
07b0: 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 23 turn. }. #
07c0: 69 66 20 7b 24 64 61 74 61 20 21 3d 20 22 22 7d if {$data != ""}
07d0: 20 7b 20 64 70 75 74 73 20 22 67 6f 74 20 24 63 { dputs "got $c
07e0: 68 61 6e 20 28 5b 73 68 6f 72 74 73 74 72 20 24 han ([shortstr $
07f0: 64 61 74 61 5d 29 22 20 7d 0a 20 20 20 20 69 66 data])" }. if
0800: 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 {[string match
0810: 2a 43 4c 4f 53 45 5c 6e 20 24 64 61 74 61 5d 7d *CLOSE\n $data]}
0820: 20 7b 0a 09 64 70 75 74 73 20 22 43 4c 4f 53 45 {..dputs "CLOSE
0830: 20 24 63 68 61 6e 22 0a 09 69 6e 63 72 20 4f 50 $chan"..incr OP
0840: 54 53 28 6f 70 65 6e 70 6f 72 74 73 29 20 2d 31 TS(openports) -1
0850: 0a 09 63 6c 6f 73 65 20 24 63 68 61 6e 0a 09 72 ..close $chan..r
0860: 65 74 75 72 6e 0a 20 20 20 20 7d 20 65 6c 73 65 eturn. } else
0870: 69 66 20 7b 5b 65 6f 66 20 24 63 68 61 6e 5d 7d if {[eof $chan]}
0880: 20 7b 0a 09 23 20 63 6c 69 65 6e 74 20 67 6f 6e {..# client gon
0890: 65 20 6f 72 20 66 69 6e 69 73 68 65 64 0a 09 64 e or finished..d
08a0: 70 75 74 73 20 22 45 4f 46 20 24 63 68 61 6e 22 puts "EOF $chan"
08b0: 0a 09 69 6e 63 72 20 4f 50 54 53 28 6f 70 65 6e ..incr OPTS(open
08c0: 70 6f 72 74 73 29 20 2d 31 0a 09 63 6c 6f 73 65 ports) -1..close
08d0: 20 24 63 68 61 6e 0a 09 72 65 74 75 72 6e 0a 20 $chan..return.
08e0: 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 66 65 65 }.}..proc fee
08f0: 64 20 7b 73 6f 63 6b 7d 20 7b 0a 20 20 20 20 64 d {sock} {. d
0900: 70 75 74 73 20 22 66 65 65 64 20 24 73 6f 63 6b puts "feed $sock
0910: 20 28 5b 73 68 6f 72 74 73 74 72 20 24 3a 3a 6d ([shortstr $::m
0920: 65 67 61 64 61 74 61 5d 29 22 0a 20 20 20 20 70 egadata])". p
0930: 75 74 73 20 24 73 6f 63 6b 20 24 3a 3a 6d 65 67 uts $sock $::meg
0940: 61 64 61 74 61 0a 20 20 20 20 66 6c 75 73 68 20 adata. flush
0950: 24 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 24 $sock. puts $
0960: 73 6f 63 6b 20 43 4c 4f 53 45 0a 20 20 20 20 66 sock CLOSE. f
0970: 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 66 lush $sock. f
0980: 69 6c 65 65 76 65 6e 74 20 24 73 6f 63 6b 20 77 ileevent $sock w
0990: 72 69 74 61 62 6c 65 20 7b 7d 0a 7d 0a 0a 70 72 ritable {}.}..pr
09a0: 6f 63 20 67 6f 20 7b 7d 20 7b 0a 20 20 20 20 67 oc go {} {. g
09b0: 6c 6f 62 61 6c 20 4f 50 54 53 0a 20 20 20 20 66 lobal OPTS. f
09c0: 6f 72 20 7b 73 65 74 20 6e 75 6d 20 24 4f 50 54 or {set num $OPT
09d0: 53 28 2d 63 6f 75 6e 74 29 7d 20 7b 24 6e 75 6d S(-count)} {$num
09e0: 20 3e 20 30 7d 20 7b 69 6e 63 72 20 6e 75 6d 20 > 0} {incr num
09f0: 2d 31 7d 20 7b 0a 09 73 65 74 20 73 6f 63 6b 20 -1} {..set sock
0a00: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 4f 50 [tls::socket $OP
0a10: 54 53 28 2d 68 6f 73 74 29 20 24 4f 50 54 53 28 TS(-host) $OPTS(
0a20: 2d 70 6f 72 74 29 5d 0a 09 69 6e 63 72 20 4f 50 -port)]..incr OP
0a30: 54 53 28 6f 70 65 6e 70 6f 72 74 73 29 0a 09 66 TS(openports)..f
0a40: 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 configure $sock
0a50: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 -blocking 0 -buf
0a60: 66 65 72 73 69 7a 65 20 34 30 39 36 0a 09 66 69 fersize 4096..fi
0a70: 6c 65 65 76 65 6e 74 20 24 73 6f 63 6b 20 77 72 leevent $sock wr
0a80: 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 66 65 65 itable [list fee
0a90: 64 20 24 73 6f 63 6b 20 5d 0a 09 66 69 6c 65 65 d $sock ]..filee
0aa0: 76 65 6e 74 20 24 73 6f 63 6b 20 72 65 61 64 61 vent $sock reada
0ab0: 62 6c 65 20 5b 6c 69 73 74 20 64 72 61 69 6e 20 ble [list drain
0ac0: 24 73 6f 63 6b 5d 0a 09 64 70 75 74 73 20 22 63 $sock]..dputs "c
0ad0: 72 65 61 74 65 64 20 24 73 6f 63 6b 22 0a 20 20 reated $sock".
0ae0: 20 20 7d 0a 20 20 20 20 77 68 69 6c 65 20 7b 31 }. while {1
0af0: 7d 20 7b 0a 09 23 20 4d 61 6b 65 20 73 75 72 65 } {..# Make sure
0b00: 20 74 6f 20 77 61 69 74 20 75 6e 74 69 6c 20 61 to wait until a
0b10: 6c 6c 20 6f 75 72 20 73 6f 63 6b 65 74 73 20 63 ll our sockets c
0b20: 6c 6f 73 65 20 64 6f 77 6e 2e 0a 09 76 77 61 69 lose down...vwai
0b30: 74 20 4f 50 54 53 28 6f 70 65 6e 70 6f 72 74 73 t OPTS(openports
0b40: 29 0a 09 69 66 20 7b 24 4f 50 54 53 28 6f 70 65 )..if {$OPTS(ope
0b50: 6e 70 6f 72 74 73 29 20 3d 3d 20 30 7d 20 7b 0a nports) == 0} {.
0b60: 09 20 20 20 20 65 78 69 74 20 30 0a 09 7d 0a 20 . exit 0..}.
0b70: 20 20 20 7d 0a 7d 0a 0a 74 6c 73 3a 3a 69 6e 69 }.}..tls::ini
0b80: 74 20 2d 63 61 66 69 6c 65 20 24 4f 50 54 53 28 t -cafile $OPTS(
0b90: 2d 63 61 66 69 6c 65 29 20 2d 63 65 72 74 66 69 -cafile) -certfi
0ba0: 6c 65 20 24 4f 50 54 53 28 2d 63 65 72 74 29 20 le $OPTS(-cert)
0bb0: 2d 6b 65 79 66 69 6c 65 20 24 4f 50 54 53 28 2d -keyfile $OPTS(-
0bc0: 6b 65 79 29 0a 0a 67 6f 0a key)..go.