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