Artifact
3d5b5fbeb8ef160d29c6734d14176723a472604f:
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 38 2e 33 20 22 24 exec tclsh8.3 "$
0050: 30 22 20 24 7b 31 2b 22 24 40 22 7d 0a 0a 70 61 0" ${1+"$@"}..pa
0060: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
0070: 73 0a 0a 73 65 74 20 64 69 72 09 09 09 5b 66 69 s..set dir...[fi
0080: 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 le join [file di
0090: 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 rname [info scri
00a0: 70 74 5d 5d 20 2e 2e 2f 74 65 73 74 73 2f 63 65 pt]] ../tests/ce
00b0: 72 74 73 5d 0a 73 65 74 20 4f 50 54 53 28 2d 63 rts].set OPTS(-c
00c0: 61 66 69 6c 65 29 09 5b 66 69 6c 65 20 6a 6f 69 afile).[file joi
00d0: 6e 20 24 64 69 72 20 63 61 63 65 72 74 2e 70 65 n $dir cacert.pe
00e0: 6d 5d 0a 73 65 74 20 4f 50 54 53 28 2d 63 65 72 m].set OPTS(-cer
00f0: 74 29 09 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 t)..[file join $
0100: 64 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a dir client.pem].
0110: 73 65 74 20 4f 50 54 53 28 2d 6b 65 79 29 09 09 set OPTS(-key)..
0120: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 64 69 72 20 [file join $dir
0130: 63 6b 65 79 2e 70 65 6d 5d 0a 0a 73 65 74 20 4f ckey.pem]..set O
0140: 50 54 53 28 2d 68 6f 73 74 29 09 09 6c 6f 63 61 PTS(-host)..loca
0150: 6c 68 6f 73 74 0a 73 65 74 20 4f 50 54 53 28 2d lhost.set OPTS(-
0160: 70 6f 72 74 29 09 09 32 34 36 38 0a 73 65 74 20 port)..2468.set
0170: 4f 50 54 53 28 2d 64 65 62 75 67 29 09 31 0a 73 OPTS(-debug).1.s
0180: 65 74 20 4f 50 54 53 28 2d 63 6f 75 6e 74 29 09 et OPTS(-count).
0190: 38 0a 73 65 74 20 4f 50 54 53 28 2d 70 61 72 61 8.set OPTS(-para
01a0: 6c 6c 65 6c 29 09 31 0a 0a 66 6f 72 65 61 63 68 llel).1..foreach
01b0: 20 7b 6b 65 79 20 76 61 6c 7d 20 24 61 72 67 76 {key val} $argv
01c0: 20 7b 0a 20 20 20 20 69 66 20 7b 21 5b 69 6e 66 {. if {![inf
01d0: 6f 20 65 78 69 73 74 73 20 4f 50 54 53 28 24 6b o exists OPTS($k
01e0: 65 79 29 5d 7d 20 7b 0a 09 70 75 74 73 20 73 74 ey)]} {..puts st
01f0: 64 65 72 72 20 22 55 73 61 67 65 3a 20 24 61 72 derr "Usage: $ar
0200: 67 76 30 20 3f 6f 70 74 69 6f 6e 73 3f 5c 0a 09 gv0 ?options?\..
0210: 09 5c 6e 5c 74 2d 64 65 62 75 67 20 20 20 20 20 .\n\t-debug
0220: 62 6f 6f 6c 65 61 6e 20 20 20 44 65 62 75 67 67 boolean Debugg
0230: 69 6e 67 20 6f 6e 20 6f 72 20 6f 66 66 20 28 24 ing on or off ($
0240: 4f 50 54 53 28 2d 64 65 62 75 67 29 29 5c 0a 09 OPTS(-debug))\..
0250: 09 5c 6e 5c 74 2d 63 61 66 69 6c 65 20 20 20 20 .\n\t-cafile
0260: 66 69 6c 65 20 20 20 20 20 20 43 65 72 74 2e 20 file Cert.
0270: 41 75 74 68 2e 20 46 69 6c 65 20 28 24 4f 50 54 Auth. File ($OPT
0280: 53 28 2d 63 61 66 69 6c 65 29 29 5c 0a 09 09 5c S(-cafile))\...\
0290: 6e 5c 74 2d 63 6c 69 65 6e 74 20 20 20 20 66 69 n\t-client fi
02a0: 6c 65 20 20 20 20 20 20 43 6c 69 65 6e 74 20 43 le Client C
02b0: 65 72 74 20 28 24 4f 50 54 53 28 2d 63 65 72 74 ert ($OPTS(-cert
02c0: 29 29 5c 0a 09 09 5c 6e 5c 74 2d 63 6b 65 79 20 ))\...\n\t-ckey
02d0: 20 20 20 20 20 66 69 6c 65 20 20 20 20 20 20 43 file C
02e0: 6c 69 65 6e 74 20 4b 65 79 20 28 24 4f 50 54 53 lient Key ($OPTS
02f0: 28 2d 6b 65 79 29 29 5c 0a 09 09 5c 6e 5c 74 2d (-key))\...\n\t-
0300: 63 6f 75 6e 74 20 20 20 20 20 6e 75 6d 20 20 20 count num
0310: 20 20 20 20 4e 6f 20 6f 66 20 73 79 6e 63 2e 20 No of sync.
0320: 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 74 6f 20 6d connections to m
0330: 61 6b 65 20 70 65 72 20 63 6c 69 65 6e 74 20 28 ake per client (
0340: 24 4f 50 54 53 28 2d 63 6f 75 6e 74 29 29 5c 0a $OPTS(-count))\.
0350: 09 09 5c 6e 5c 74 2d 70 61 72 61 6c 6c 65 6c 20 ..\n\t-parallel
0360: 20 6e 75 6d 20 20 20 20 20 20 20 4e 6f 20 6f 66 num No of
0370: 20 70 61 72 61 6c 6c 65 6c 20 63 6c 69 65 6e 74 parallel client
0380: 73 20 74 6f 20 72 75 6e 20 28 24 4f 50 54 53 28 s to run ($OPTS(
0390: 2d 70 61 72 61 6c 6c 65 6c 29 29 5c 0a 09 09 5c -parallel))\...\
03a0: 6e 5c 74 2d 68 6f 73 74 20 20 20 20 20 20 68 6f n\t-host ho
03b0: 73 74 6e 61 6d 65 20 20 53 65 72 76 65 72 20 68 stname Server h
03c0: 6f 73 74 6e 61 6d 65 20 28 24 4f 50 54 53 28 2d ostname ($OPTS(-
03d0: 68 6f 73 74 29 29 5c 0a 09 09 5c 6e 5c 74 2d 70 host))\...\n\t-p
03e0: 6f 72 74 20 20 20 20 20 20 6e 75 6d 20 20 20 20 ort num
03f0: 20 20 20 53 65 72 76 65 72 20 70 6f 72 74 20 28 Server port (
0400: 24 4f 50 54 53 28 2d 70 6f 72 74 29 29 22 0a 09 $OPTS(-port))"..
0410: 65 78 69 74 0a 20 20 20 20 7d 0a 20 20 20 20 73 exit. }. s
0420: 65 74 20 4f 50 54 53 28 24 6b 65 79 29 20 24 76 et OPTS($key) $v
0430: 61 6c 0a 7d 0a 0a 69 66 20 7b 24 4f 50 54 53 28 al.}..if {$OPTS(
0440: 2d 70 61 72 61 6c 6c 65 6c 29 20 3e 20 31 7d 20 -parallel) > 1}
0450: 7b 0a 20 20 20 20 23 20 49 66 20 74 68 65 79 20 {. # If they
0460: 77 61 6e 74 65 64 20 70 61 72 61 6c 6c 65 6c 2c wanted parallel,
0470: 20 77 65 20 6a 75 73 74 20 73 70 61 77 6e 20 6f we just spawn o
0480: 75 72 73 65 6c 76 65 73 20 73 65 76 65 72 61 6c urselves several
0490: 20 74 69 6d 65 73 0a 20 20 20 20 23 20 77 69 74 times. # wit
04a0: 68 20 74 68 65 20 72 69 67 68 74 20 61 72 67 73 h the right args
04b0: 2e 0a 0a 20 20 20 20 73 65 74 20 63 6d 64 09 5b ... set cmd.[
04c0: 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 info nameofexecu
04d0: 74 61 62 6c 65 5d 0a 20 20 20 20 73 65 74 20 73 table]. set s
04e0: 63 72 69 70 74 09 5b 69 6e 66 6f 20 73 63 72 69 cript.[info scri
04f0: 70 74 5d 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 pt]. for {set
0500: 20 69 20 30 7d 20 7b 24 69 20 3c 20 24 4f 50 54 i 0} {$i < $OPT
0510: 53 28 2d 70 61 72 61 6c 6c 65 6c 29 7d 20 7b 69 S(-parallel)} {i
0520: 6e 63 72 20 69 7d 20 7b 0a 09 65 76 61 6c 20 5b ncr i} {..eval [
0530: 6c 69 73 74 20 65 78 65 63 20 24 63 6d 64 20 24 list exec $cmd $
0540: 73 63 72 69 70 74 5d 20 5b 61 72 72 61 79 20 67 script] [array g
0550: 65 74 20 4f 50 54 53 5d 20 5b 6c 69 73 74 20 2d et OPTS] [list -
0560: 70 61 72 61 6c 6c 65 6c 20 30 5d 20 26 0a 20 20 parallel 0] &.
0570: 20 20 7d 0a 20 20 20 20 65 78 69 74 0a 7d 0a 0a }. exit.}..
0580: 23 20 4c 6f 63 61 6c 20 68 61 6e 64 6c 65 72 20 # Local handler
0590: 66 6f 72 20 61 6e 79 20 62 61 63 6b 67 72 6f 75 for any backgrou
05a0: 6e 64 20 65 72 72 6f 72 73 2e 0a 70 72 6f 63 20 nd errors..proc
05b0: 62 67 65 72 72 6f 72 20 7b 6d 73 67 7d 20 7b 20 bgerror {msg} {
05c0: 70 75 74 73 20 22 42 47 45 52 52 4f 52 3a 20 24 puts "BGERROR: $
05d0: 6d 73 67 22 20 7d 0a 0a 23 20 64 65 62 75 67 67 msg" }..# debugg
05e0: 69 6e 67 20 68 65 6c 70 65 72 20 63 6f 64 65 0a ing helper code.
05f0: 70 72 6f 63 20 73 68 6f 72 74 73 74 72 20 7b 73 proc shortstr {s
0600: 74 72 7d 20 7b 0a 20 20 20 20 72 65 74 75 72 6e tr} {. return
0610: 20 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 "[string replac
0620: 65 20 24 73 74 72 20 31 30 20 65 6e 64 20 2e 2e e $str 10 end ..
0630: 2e 5d 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 .] [string lengt
0640: 68 20 24 73 74 72 5d 62 22 0a 7d 0a 70 72 6f 63 h $str]b".}.proc
0650: 20 64 70 75 74 73 20 7b 6d 73 67 7d 20 7b 20 69 dputs {msg} { i
0660: 66 20 7b 24 3a 3a 4f 50 54 53 28 2d 64 65 62 75 f {$::OPTS(-debu
0670: 67 29 7d 20 7b 20 70 75 74 73 20 73 74 64 65 72 g)} { puts stder
0680: 72 20 24 6d 73 67 20 3b 20 66 6c 75 73 68 20 73 r $msg ; flush s
0690: 74 64 65 72 72 20 7d 20 7d 0a 0a 73 65 74 20 4f tderr } }..set O
06a0: 50 54 53 28 6f 70 65 6e 70 6f 72 74 73 29 09 30 PTS(openports).0
06b0: 0a 0a 23 20 44 65 66 69 6e 65 20 77 68 61 74 20 ..# Define what
06c0: 77 65 20 77 61 6e 74 20 74 6f 20 66 65 65 64 20 we want to feed
06d0: 64 6f 77 6e 20 74 68 65 20 70 69 70 65 0a 73 65 down the pipe.se
06e0: 74 20 6d 65 67 61 64 61 74 61 20 5b 73 74 72 69 t megadata [stri
06f0: 6e 67 20 72 65 70 65 61 74 20 5b 73 74 72 69 6e ng repeat [strin
0700: 67 20 72 65 70 65 61 74 20 41 20 37 36 5d 5c 6e g repeat A 76]\n
0710: 20 31 30 30 30 5d 0a 0a 70 72 6f 63 20 64 72 61 1000]..proc dra
0720: 69 6e 20 7b 63 68 61 6e 7d 20 7b 0a 20 20 20 20 in {chan} {.
0730: 67 6c 6f 62 61 6c 20 4f 50 54 53 0a 20 20 20 20 global OPTS.
0740: 69 66 20 7b 5b 63 61 74 63 68 20 7b 72 65 61 64 if {[catch {read
0750: 20 24 63 68 61 6e 7d 20 64 61 74 61 5d 7d 20 7b $chan} data]} {
0760: 0a 09 23 64 70 75 74 73 20 22 45 4f 46 20 24 63 ..#dputs "EOF $c
0770: 68 61 6e 20 28 5b 73 68 6f 72 74 73 74 72 20 24 han ([shortstr $
0780: 64 61 74 61 5d 29 22 0a 09 69 6e 63 72 20 4f 50 data])"..incr OP
0790: 54 53 28 6f 70 65 6e 70 6f 72 74 73 29 20 2d 31 TS(openports) -1
07a0: 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 ..catch {close $
07b0: 63 68 61 6e 7d 0a 09 72 65 74 75 72 6e 0a 20 20 chan}..return.
07c0: 20 20 7d 0a 20 20 20 20 23 69 66 20 7b 24 64 61 }. #if {$da
07d0: 74 61 20 21 3d 20 22 22 7d 20 7b 20 64 70 75 74 ta != ""} { dput
07e0: 73 20 22 67 6f 74 20 24 63 68 61 6e 20 28 5b 73 s "got $chan ([s
07f0: 68 6f 72 74 73 74 72 20 24 64 61 74 61 5d 29 22 hortstr $data])"
0800: 20 7d 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 }. if {[stri
0810: 6e 67 20 6d 61 74 63 68 20 2a 43 4c 4f 53 45 5c ng match *CLOSE\
0820: 6e 20 24 64 61 74 61 5d 7d 20 7b 0a 09 64 70 75 n $data]} {..dpu
0830: 74 73 20 22 43 4c 4f 53 45 20 24 63 68 61 6e 22 ts "CLOSE $chan"
0840: 0a 09 69 6e 63 72 20 4f 50 54 53 28 6f 70 65 6e ..incr OPTS(open
0850: 70 6f 72 74 73 29 20 2d 31 0a 09 63 6c 6f 73 65 ports) -1..close
0860: 20 24 63 68 61 6e 0a 09 72 65 74 75 72 6e 0a 20 $chan..return.
0870: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f } elseif {[eo
0880: 66 20 24 63 68 61 6e 5d 7d 20 7b 0a 09 23 20 63 f $chan]} {..# c
0890: 6c 69 65 6e 74 20 67 6f 6e 65 20 6f 72 20 66 69 lient gone or fi
08a0: 6e 69 73 68 65 64 0a 09 64 70 75 74 73 20 22 45 nished..dputs "E
08b0: 4f 46 20 24 63 68 61 6e 22 0a 09 69 6e 63 72 20 OF $chan"..incr
08c0: 4f 50 54 53 28 6f 70 65 6e 70 6f 72 74 73 29 20 OPTS(openports)
08d0: 2d 31 0a 09 63 6c 6f 73 65 20 24 63 68 61 6e 0a -1..close $chan.
08e0: 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 7d 0a .return. }.}.
08f0: 0a 70 72 6f 63 20 66 65 65 64 20 7b 73 6f 63 6b .proc feed {sock
0900: 7d 20 7b 0a 20 20 20 20 64 70 75 74 73 20 22 66 } {. dputs "f
0910: 65 65 64 20 24 73 6f 63 6b 20 28 5b 73 68 6f 72 eed $sock ([shor
0920: 74 73 74 72 20 24 3a 3a 6d 65 67 61 64 61 74 61 tstr $::megadata
0930: 5d 29 22 0a 20 20 20 20 70 75 74 73 20 24 73 6f ])". puts $so
0940: 63 6b 20 24 3a 3a 6d 65 67 61 64 61 74 61 0a 20 ck $::megadata.
0950: 20 20 20 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 flush $sock.
0960: 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 43 4c puts $sock CL
0970: 4f 53 45 0a 20 20 20 20 66 6c 75 73 68 20 24 73 OSE. flush $s
0980: 6f 63 6b 0a 20 20 20 20 66 69 6c 65 65 76 65 6e ock. fileeven
0990: 74 20 24 73 6f 63 6b 20 77 72 69 74 61 62 6c 65 t $sock writable
09a0: 20 7b 7d 0a 7d 0a 0a 70 72 6f 63 20 67 6f 20 7b {}.}..proc go {
09b0: 7d 20 7b 0a 20 20 20 20 67 6c 6f 62 61 6c 20 4f } {. global O
09c0: 50 54 53 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 PTS. for {set
09d0: 20 6e 75 6d 20 24 4f 50 54 53 28 2d 63 6f 75 6e num $OPTS(-coun
09e0: 74 29 7d 20 7b 24 6e 75 6d 20 3e 20 30 7d 20 7b t)} {$num > 0} {
09f0: 69 6e 63 72 20 6e 75 6d 20 2d 31 7d 20 7b 0a 09 incr num -1} {..
0a00: 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 set sock [tls::s
0a10: 6f 63 6b 65 74 20 24 4f 50 54 53 28 2d 68 6f 73 ocket $OPTS(-hos
0a20: 74 29 20 24 4f 50 54 53 28 2d 70 6f 72 74 29 5d t) $OPTS(-port)]
0a30: 0a 09 69 6e 63 72 20 4f 50 54 53 28 6f 70 65 6e ..incr OPTS(open
0a40: 70 6f 72 74 73 29 0a 09 66 63 6f 6e 66 69 67 75 ports)..fconfigu
0a50: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
0a60: 6e 67 20 30 20 2d 62 75 66 66 65 72 73 69 7a 65 ng 0 -buffersize
0a70: 20 34 30 39 36 0a 09 66 69 6c 65 65 76 65 6e 74 4096..fileevent
0a80: 20 24 73 6f 63 6b 20 77 72 69 74 61 62 6c 65 20 $sock writable
0a90: 5b 6c 69 73 74 20 66 65 65 64 20 24 73 6f 63 6b [list feed $sock
0aa0: 20 5d 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 ]..fileevent $s
0ab0: 6f 63 6b 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 ock readable [li
0ac0: 73 74 20 64 72 61 69 6e 20 24 73 6f 63 6b 5d 0a st drain $sock].
0ad0: 09 64 70 75 74 73 20 22 63 72 65 61 74 65 64 20 .dputs "created
0ae0: 24 73 6f 63 6b 22 0a 20 20 20 20 7d 0a 20 20 20 $sock". }.
0af0: 20 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 23 20 while {1} {..#
0b00: 4d 61 6b 65 20 73 75 72 65 20 74 6f 20 77 61 69 Make sure to wai
0b10: 74 20 75 6e 74 69 6c 20 61 6c 6c 20 6f 75 72 20 t until all our
0b20: 73 6f 63 6b 65 74 73 20 63 6c 6f 73 65 20 64 6f sockets close do
0b30: 77 6e 2e 0a 09 76 77 61 69 74 20 4f 50 54 53 28 wn...vwait OPTS(
0b40: 6f 70 65 6e 70 6f 72 74 73 29 0a 09 69 66 20 7b openports)..if {
0b50: 24 4f 50 54 53 28 6f 70 65 6e 70 6f 72 74 73 29 $OPTS(openports)
0b60: 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 65 78 == 0} {.. ex
0b70: 69 74 20 30 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a it 0..}. }.}.
0b80: 0a 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 61 66 69 .tls::init -cafi
0b90: 6c 65 20 24 4f 50 54 53 28 2d 63 61 66 69 6c 65 le $OPTS(-cafile
0ba0: 29 20 2d 63 65 72 74 66 69 6c 65 20 24 4f 50 54 ) -certfile $OPT
0bb0: 53 28 2d 63 65 72 74 29 20 2d 6b 65 79 66 69 6c S(-cert) -keyfil
0bc0: 65 20 24 4f 50 54 53 28 2d 6b 65 79 29 0a 0a 67 e $OPTS(-key)..g
0bd0: 6f 0a o.