Index: ChangeLog ================================================================== --- ChangeLog +++ ChangeLog @@ -1,5 +1,11 @@ +2000-08-15 Jeff Hobbs + + * 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 * tlsInt.h: * tlsIO.c: * tlsBIO.c: ADDED tests/simpleClient.tcl Index: tests/simpleClient.tcl ================================================================== --- /dev/null +++ tests/simpleClient.tcl @@ -0,0 +1,113 @@ +#!/bin/sh +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh8.3 "$0" ${1+"$@"} + +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 ADDED tests/simpleServer.tcl Index: tests/simpleServer.tcl ================================================================== --- /dev/null +++ tests/simpleServer.tcl @@ -0,0 +1,90 @@ +#!/bin/sh +# The next line is executed by /bin/sh, but not tcl \ +exec tclsh8.3 "$0" ${1+"$@"} + +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__