Overview
Comment: | * tests/simpleClient.tcl: * tests/simpleServer.tcl: added simple client/server test scripts that use test certs and can do simple stress tests. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
2f852e2ef62669b918fac046b734867d |
User & Date: | hobbs on 2000-08-15 17:05:10 |
Other Links: | manifest | tags |
Context
2000-08-15
| ||
18:45 | * tests/all.tcl: added catch around ::tcltest::normalizePath because it doesn't exist in pre-8.3 tcltest. check-in: a0a66662a3 user: hobbs tags: trunk | |
17:05 | * tests/simpleClient.tcl: * tests/simpleServer.tcl: added simple client/server test scripts that use test certs and can do simple stress tests. check-in: 2f852e2ef6 user: hobbs tags: trunk | |
00:02 | * 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. check-in: 33ea0b5a9d user: hobbs tags: trunk | |
Changes
Modified ChangeLog from [90bb6e0e94] to [00d4c60b28].
1 2 3 4 5 6 7 | 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. | > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 | 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. |
︙ | ︙ |
Added tests/simpleClient.tcl version [3d5b5fbeb8].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 | #!/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 |
Added tests/simpleServer.tcl version [86951f40b8].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | #!/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__ |