2000-08-15  Jeff Hobbs  <[email protected]>

	* tests/simpleClient.tcl: 
	* tests/simpleServer.tcl: added simple client/server test scripts
	that use test certs and can do simple stress tests.

2000-08-14  Jeff Hobbs  <[email protected]>

	* tlsInt.h:
	* tlsIO.c:
	* tlsBIO.c:
	* tls.c: changed around to only working with 8.2.0+ (8.3.2+
	preferred), with runtime checks for pre- and post-io-rewrite.

#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec tclsh8.3 "$0" ${1+"[email protected]"}

package require tls

set dir			[file join [file dirname [info script]] ../tests/certs]
set OPTS(-cafile)	[file join $dir cacert.pem]
set OPTS(-cert)		[file join $dir client.pem]
set OPTS(-key)		[file join $dir ckey.pem]

set OPTS(-host)		localhost
set OPTS(-port)		2468
set OPTS(-debug)	1
set OPTS(-count)	8
set OPTS(-parallel)	1

foreach {key val} $argv {
    if {![info exists OPTS($key)]} {
	puts stderr "Usage: $argv0 ?options?\
		\n\t-debug     boolean   Debugging on or off ($OPTS(-debug))\
		\n\t-cafile    file      Cert. Auth. File ($OPTS(-cafile))\
		\n\t-client    file      Client Cert ($OPTS(-cert))\
		\n\t-ckey      file      Client Key ($OPTS(-key))\
		\n\t-count     num       No of sync. connections to make per client ($OPTS(-count))\
		\n\t-parallel  num       No of parallel clients to run ($OPTS(-parallel))\
		\n\t-host      hostname  Server hostname ($OPTS(-host))\
		\n\t-port      num       Server port ($OPTS(-port))"
	exit
    }
    set OPTS($key) $val
}

if {$OPTS(-parallel) > 1} {
    # If they wanted parallel, we just spawn ourselves several times
    # with the right args.

    set cmd	[info nameofexecutable]
    set script	[info script]
    for {set i 0} {$i < $OPTS(-parallel)} {incr i} {
	eval [list exec $cmd $script] [array get OPTS] [list -parallel 0] &
    }
    exit
}

# Local handler for any background errors.
proc bgerror {msg} { puts "BGERROR: $msg" }

# debugging helper code
proc shortstr {str} {
    return "[string replace $str 10 end ...] [string length $str]b"
}
proc dputs {msg} { if {$::OPTS(-debug)} { puts stderr $msg ; flush stderr } }

set OPTS(openports)	0

# Define what we want to feed down the pipe
set megadata [string repeat [string repeat A 76]\n 1000]

proc drain {chan} {
    global OPTS
    if {[catch {read $chan} data]} {
	#dputs "EOF $chan ([shortstr $data])"
	incr OPTS(openports) -1
	catch {close $chan}
	return
    }
    #if {$data != ""} { dputs "got $chan ([shortstr $data])" }
    if {[string match *CLOSE\n $data]} {
	dputs "CLOSE $chan"
	incr OPTS(openports) -1
	close $chan
	return
    } elseif {[eof $chan]} {
	# client gone or finished
	dputs "EOF $chan"
	incr OPTS(openports) -1
	close $chan
	return
    }
}

proc feed {sock} {
    dputs "feed $sock ([shortstr $::megadata])"
    puts $sock $::megadata
    flush $sock
    puts $sock CLOSE
    flush $sock
    fileevent $sock writable {}
}

proc go {} {
    global OPTS
    for {set num $OPTS(-count)} {$num > 0} {incr num -1} {
	set sock [tls::socket $OPTS(-host) $OPTS(-port)]
	incr OPTS(openports)
	fconfigure $sock -blocking 0 -buffersize 4096
	fileevent $sock writable [list feed $sock ]
	fileevent $sock readable [list drain $sock]
	dputs "created $sock"
    }
    while {1} {
	# Make sure to wait until all our sockets close down.
	vwait OPTS(openports)
	if {$OPTS(openports) == 0} {
	    exit 0
	}
    }
}

tls::init -cafile $OPTS(-cafile) -certfile $OPTS(-cert) -keyfile $OPTS(-key)

go

#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
exec tclsh8.3 "$0" ${1+"[email protected]"}

package require tls

set dir			[file join [file dirname [info script]] ../tests/certs]
set OPTS(-cafile)	[file join $dir cacert.pem]
set OPTS(-cert)		[file join $dir server.pem]
set OPTS(-key)		[file join $dir skey.pem]

set OPTS(-port)	2468
set OPTS(-debug) 1
set OPTS(-require) 1

foreach {key val} $argv {
    if {![info exists OPTS($key)]} {
	puts stderr "Usage: $argv0 ?options?\
		\n\t-debug    boolean  Debugging on or off ($OPTS(-debug))\
		\n\t-cafile   file     Cert. Auth. File ($OPTS(-cafile))\
		\n\t-cert     file     Server Cert ($OPTS(-cert))\
		\n\t-key      file     Server Key ($OPTS(-key))\
		\n\t-require  boolean  Require Certification ($OPTS(-require))\
		\n\t-port     num      Port to listen on ($OPTS(-port))"
	exit
    }
    set OPTS($key) $val
}

# Catch  any background errors.
proc bgerror {msg} { puts stderr "BGERROR: $msg" }

# debugging helper code
proc shortstr {str} {
    return "[string replace $str 10 end ...] [string length $str]b"
}
proc dputs {msg} { if {$::OPTS(-debug)} { puts stderr $msg ; flush stderr } }

# As a response we just echo the data sent to us.
#
proc respond {chan} {
    if {[catch {read $chan} data]} {
	#dputs "EOF $chan ([shortstr $data)"
	catch {close $chan}
	return
    }
    #if {$data != ""} { dputs "got $chan ([shortstr $data])" }
    if {[eof $chan]} {
	# client gone or finished
	dputs "EOF $chan"
	close $chan		;#  release the port
	return
    }
    puts -nonewline $chan $data
    flush $chan
    #dputs "sent $chan ([shortstr $data])"
}

# Once connection is established, we need to ensure handshake.
#
proc handshake {s cmd} {
    if {[eof $s]} {
	dputs "handshake eof $s"
	close $s
    } elseif {[catch {tls::handshake $s} result]} {
	# Some errors are normal.  Specifically, I (hobbs) believe that
	# TLS throws EAGAINs when it may not need to (or is inappropriate).
	dputs "handshake error $s: $result"
    } elseif {$result == 1} {
	# Handshake complete
	dputs "handshake complete $s"
	fileevent $s readable [list $cmd $s]
    }
}

# Callback proc to accept a connection from a client.
#
proc accept { chan ip port } {
    dputs "[info level 0] [fconfigure $chan]"
    fconfigure $chan -blocking 0
    fileevent $chan readable [list handshake $chan respond]
}

tls::init -cafile $OPTS(-cafile) -certfile $OPTS(-cert) -keyfile $OPTS(-key)
set chan [tls::socket -server accept -require $OPTS(-require) $OPTS(-port)]

puts "Server waiting connection on $chan ($OPTS(-port))"
puts [fconfigure $chan]

vwait __forever__