1#!/bin/sh 2# The next line is executed by /bin/sh, but not tcl \ 3exec tclsh8.3 "$0" ${1+"$@"} 4 5package require tls 6 7set dir [file join [file dirname [info script]] ../tests/certs] 8set OPTS(-cafile) [file join $dir ca.pem] 9set OPTS(-cert) [file join $dir client.pem] 10set OPTS(-key) [file join $dir client.key] 11 12set OPTS(-host) lorax 13set OPTS(-port) 2468 14set OPTS(-debug) 1 15set OPTS(-count) 8 16set OPTS(-parallel) 1 17 18foreach {key val} $argv { 19 if {![info exists OPTS($key)]} { 20 puts stderr "Usage: $argv0 ?options?\ 21 \n\t-debug boolean Debugging on or off ($OPTS(-debug))\ 22 \n\t-cafile file Cert. Auth. File ($OPTS(-cafile))\ 23 \n\t-client file Client Cert ($OPTS(-cert))\ 24 \n\t-ckey file Client Key ($OPTS(-key))\ 25 \n\t-count num No of sync. connections to make per client ($OPTS(-count))\ 26 \n\t-parallel num No of parallel clients to run ($OPTS(-parallel))\ 27 \n\t-host hostname Server hostname ($OPTS(-host))\ 28 \n\t-port num Server port ($OPTS(-port))" 29 exit 30 } 31 set OPTS($key) $val 32} 33 34if {$OPTS(-parallel) > 1} { 35 # If they wanted parallel, we just spawn ourselves several times 36 # with the right args. 37 38 set cmd [info nameofexecutable] 39 set script [info script] 40 for {set i 0} {$i < $OPTS(-parallel)} {incr i} { 41 eval [list exec $cmd $script] [array get OPTS] [list -parallel 0] & 42 } 43 exit 44} 45 46# Local handler for any background errors. 47proc bgerror {msg} { puts "BGERROR: $msg" } 48 49# debugging helper code 50proc shortstr {str} { 51 return "[string replace $str 10 end ...] [string length $str]b" 52} 53proc dputs {msg} { if {$::OPTS(-debug)} { puts stderr $msg ; flush stderr } } 54 55set OPTS(openports) 0 56 57# Define what we want to feed down the pipe 58set megadata [string repeat [string repeat A 76]\n 1000] 59 60proc drain {chan} { 61 global OPTS 62 if {[catch {read $chan} data]} { 63 #dputs "EOF $chan ([shortstr $data])" 64 incr OPTS(openports) -1 65 catch {close $chan} 66 return 67 } 68 #if {$data != ""} { dputs "got $chan ([shortstr $data])" } 69 if {[string match *CLOSE\n $data]} { 70 dputs "CLOSE $chan" 71 incr OPTS(openports) -1 72 close $chan 73 return 74 } elseif {[eof $chan]} { 75 # client gone or finished 76 dputs "EOF $chan" 77 incr OPTS(openports) -1 78 close $chan 79 return 80 } 81} 82 83proc feed {sock} { 84 dputs "feed $sock ([shortstr $::megadata])" 85 puts $sock $::megadata 86 flush $sock 87 puts $sock CLOSE 88 flush $sock 89 fileevent $sock writable {} 90} 91 92proc go {} { 93 global OPTS 94 for {set num $OPTS(-count)} {$num > 0} {incr num -1} { 95 set sock [tls::socket $OPTS(-host) $OPTS(-port)] 96 incr OPTS(openports) 97 fconfigure $sock -blocking 0 -buffersize 4096 98 fileevent $sock writable [list feed $sock ] 99 fileevent $sock readable [list drain $sock] 100 dputs "created $sock" 101 } 102 while {1} { 103 # Make sure to wait until all our sockets close down. 104 vwait OPTS(openports) 105 if {$OPTS(openports) == 0} { 106 exit 0 107 } 108 } 109} 110 111tls::init -cafile $OPTS(-cafile) -certfile $OPTS(-cert) -keyfile $OPTS(-key) 112 113go 114