@@ -8,11 +8,11 @@ # Copyright (c) 1998-2000 Ajuba Solutions. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tlsIO.test,v 1.9 2000/06/06 01:50:36 aborr Exp $ +# RCS: @(#) $Id: tlsIO.test,v 1.10 2000/06/06 22:00:48 aborr Exp $ # Running socket tests with a remote server: # ------------------------------------------ # # Some tests in socket.test depend on the existence of a remote server to @@ -19,11 +19,11 @@ # which they connect. The remote server must be an instance of tcltest and it # must run the script found in the file "remote.tcl" in this directory. You # can start the remote server on any machine reachable from the machine on # which you want to run the socket tests, by issuing: # -# tcltest remote.tcl -port 2048 # Or choose another port number. +# tcltest remote.tcl -port 8048 # Or choose another port number. # # If the machine you are running the remote server on has several IP # interfaces, you can choose which interface the server listens on for # connections by specifying the -address command line flag, so: # @@ -30,47 +30,50 @@ # tcltest remote.tcl -address your.machine.com # # These options can also be set by environment variables. On Unix, you can # type these commands to the shell from which the remote server is started: # -# shell% setenv serverPort 2048 +# shell% setenv serverPort 8048 # shell% setenv serverAddress your.machine.com # # and subsequently you can start the remote server with: # # tcltest remote.tcl # -# to have it listen on port 2048 on the interface your.machine.com. +# to have it listen on port 8048 on the interface your.machine.com. # # When the server starts, it prints out a detailed message containing its # configuration information, and it will block until killed with a Ctrl-C. # Once the remote server exists, you can run the tests in socket.test with # the server by setting two Tcl variables: # # % set remoteServerIP -# % set remoteServerPort 2048 +# % set remoteServerPort 8048 # # These variables are also settable from the environment. On Unix, you can: # # shell% setenv remoteServerIP machine.where.server.runs -# shell% senetv remoteServerPort 2048 +# shell% senetv remoteServerPort 8048 # # The preamble of the socket.test file checks to see if the variables are set # either in Tcl or in the environment; if they are, it attempts to connect to # the server. If the connection is successful, the tests using the remote # server will be performed; otherwise, it will attempt to start the remote # server (via exec) on platforms that support this, on the local host, -# listening at port 2048. If all fails, a message is printed and the tests +# listening at port 8048. If all fails, a message is printed and the tests # using the remote server are not performed. if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Load the tls package + package require tls + +set tlsServerPort 8048 set certsDir [file join [file dirname [info script]] certs] set serverCert [file join $certsDir server.pem] set clientCert [file join $certsDir client.pem] @@ -96,11 +99,11 @@ if {![info exists remoteServerPort]} { if {[info exists env(remoteServerPort)]} { set remoteServerPort $env(remoteServerPort) } else { if {[info exists remoteServerIP]} { - set remoteServerPort 2048 + set remoteServerPort $tlsServerPort } } } # @@ -110,16 +113,16 @@ set doTestsWithRemoteServer 1 if {![info exists remoteServerIP] && ($tcl_platform(platform) != "macintosh")} { set remoteServerIP 127.0.0.1 } if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} { - set remoteServerPort 2048 + set remoteServerPort $tlsServerPort } # Attempt to connect to a remote server if one is already running. If it # is not running or for some other reason the connect fails, attempt to -# start the remote server on the local host listening on port 2048. This +# start the remote server on the local host listening on port 8048. This # is only done on platforms that support exec (i.e. not on the Mac). On # platforms that do not support exec, the remote server must be started # by the user before running the tests. set remoteProcChan "" @@ -265,11 +268,11 @@ set f [open script w] puts $f { package require tls set timer [after 2000 "set x timed_out"] } - puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2828 \]" + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey $tlsServerPort \]" puts $f { proc accept {file addr port} { global x set x done close $file @@ -282,11 +285,11 @@ } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {tls::socket -certfile $clientCert -cafile $caCert \ - -keyfile $clientKey 127.0.0.1 2828} msg]} { + -keyfile $clientKey 127.0.0.1 $tlsServerPort msg]} { set x $msg } else { lappend x [gets $f] close $msg } @@ -296,21 +299,21 @@ } {ready done {}} if [info exists port] { incr port } else { - set port [expr 2048 + [pid]%1024] + set port [expr $tlsServerPort + [pid]%1024] } test tlsIO-2.2 {tcp connection with client port specified} {socket stdio} { removeFile script set f [open script w] puts $f { package require tls set timer [after 2000 "set x done"] } - puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2829 \]" + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8829 \]" puts $f { proc accept {file addr port} { global x puts "[gets $file] $port" close $file @@ -325,13 +328,13 @@ set f [open "|[list $::tcltest::tcltest script]" r] gets $f x global port if {[catch {tls::socket -myport $port \ -certfile $clientCert -cafile $caCert \ - -keyfile $clientKey 127.0.0.1 2829} sock]} { + -keyfile $clientKey 127.0.0.1 8829} sock]} { set x $sock - catch {close [tls::socket 127.0.0.1 2829]} + catch {close [tls::socket 127.0.0.1 8829]} } else { puts $sock hello flush $sock lappend x [gets $f] close $sock @@ -345,11 +348,11 @@ set f [open script w] puts $f { package require tls set timer [after 2000 "set x done"] } - puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2830 \]" + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8830 \]" puts $f { proc accept {file addr port} { global x puts "[gets $file] $addr" close $file @@ -363,11 +366,11 @@ close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {tls::socket -myaddr 127.0.0.1 \ -certfile $clientCert -cafile $caCert \ - -keyfile $clientKey 127.0.0.1 2830} sock]} { + -keyfile $clientKey 127.0.0.1 8830} sock]} { set x $sock } else { puts $sock hello catch {flush $sock} lappend x [gets $f] @@ -382,11 +385,11 @@ set f [open script w] puts $f { package require tls set timer [after 2000 "set x done"] } - puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey -myaddr [info hostname] 2831 \]" + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey -myaddr [info hostname] 8831 \]" puts $f { proc accept {file addr port} { global x puts "[gets $file]" close $file @@ -399,11 +402,11 @@ } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {tls::socket -certfile $clientCert -cafile $caCert \ - -keyfile $clientKey [info hostname] 2831} sock]} { + -keyfile $clientKey [info hostname] 8831} sock]} { set x $sock } else { puts $sock hello flush $sock lappend x [gets $f] @@ -418,11 +421,11 @@ set f [open script w] puts $f { package require tls set timer [after 2000 "set x done"] } - puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2832 \]" + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8832 \]" puts $f { proc accept {file addr port} { global x puts "[gets $file]" close $file @@ -435,11 +438,11 @@ } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x if {[catch {tls::socket -certfile $clientCert -cafile $caCert \ - -keyfile $clientKey 127.0.0.1 2832} sock]} { + -keyfile $clientKey 127.0.0.1 8832} sock]} { set x $sock } else { puts $sock hello flush $sock lappend x [gets $f] @@ -448,11 +451,11 @@ close $f set x } {ready hello} test tlsIO-2.6 {tcp connection} {socket} { set status ok - if {![catch {set sock [tls::socket 127.0.0.1 2833]}]} { + if {![catch {set sock [tls::socket 127.0.0.1 8833]}]} { if {![catch {gets $sock}]} { set status broken } close $sock } @@ -464,11 +467,11 @@ set f [open script w] puts $f { package require tls set timer [after 2000 "set x done"] } - puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2834 \]" + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8834 \]" puts $f { proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -translation lf -buffering line } @@ -490,11 +493,11 @@ } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [tls::socket -certfile $clientCert -cafile $caCert \ - -keyfile $clientKey 127.0.0.1 2834] + -keyfile $clientKey 127.0.0.1 8834] fconfigure $s -buffering line -translation lf puts $s "hello abcdefghijklmnop" after 1000 set x [gets $s] close $s @@ -506,11 +509,11 @@ test tlsIO-2.8 {echo server, loop 50 times, single connection} {socket stdio} { set f [open script w] puts $f { package require tls } - puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2835 \]" + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8835 \]" puts $f { proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line } @@ -536,11 +539,11 @@ } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [tls::socket -certfile $clientCert -cafile $caCert \ - -keyfile $clientKey 127.0.0.1 2835] + -keyfile $clientKey 127.0.0.1 8835] fconfigure $s -buffering line catch { for {set x 0} {$x < 50} {incr x} { puts $s "hello abcdefghijklmnop" gets $s @@ -551,37 +554,37 @@ close $f set x } {done 50} test tlsIO-2.9 {socket conflict} {socket stdio} { - set s [tls::socket -server accept 2828] + set s [tls::socket -server accept 8828] removeFile script set f [open script w] - puts -nonewline $f {package require tls; tls::socket -server accept 2828} + puts -nonewline $f {package require tls; tls::socket -server accept 8828} close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f after 100 set x [list [catch {close $f} msg] $msg] close $s set x } {1 {couldn't open socket: address already in use while executing -"::socket -server {tls::_accept {-server 1} accept} 2828" +"::socket -server {tls::_accept {-server 1} accept} 8828" ("eval" body line 1) invoked from within "eval ::socket $sopts" (procedure "tls::socket" line 62) invoked from within -"tls::socket -server accept 2828" +"tls::socket -server accept 8828" (file "script" line 1)}} test tlsIO-2.10 {close on accept, accepted socket lives} {socket knownBug} { set done 0 set timer [after 20000 "set done timed_out"] set ss [tls::socket -server accept -certfile $serverCert -cafile $caCert \ - -keyfile $serverKey 2830] + -keyfile $serverKey 8830] proc accept {s a p} { global ss close $ss fileevent $s readable "readit $s" fconfigure $s -trans lf @@ -591,11 +594,11 @@ gets $s close $s set done 1 } set cs [tls::socket -certfile $clientCert -cafile $caCert \ - -keyfile $clientKey [info hostname] 2830] + -keyfile $clientKey [info hostname] 8830] close $cs vwait done after cancel $timer set done @@ -611,14 +614,14 @@ puts $f "[tls::status $sock]" close $s } set s [tls::socket -require 0 -request 0 -server accept -certfile $serverCert -cafile $caCert \ - -keyfile $serverKey 2400] + -keyfile $serverKey 8400] set sock "" set s2 [tls::socket -certfile $clientCert -cafile $caCert \ - -keyfile $clientKey 127.0.0.1 2400] + -keyfile $clientKey 127.0.0.1 8400] vwait sock puts $s2 one flush $s2 after 500 fconfigure $sock -blocking 0 @@ -640,11 +643,11 @@ removeFile script set f [open script w] puts $f { package require tls set timer [after 2000 "set x timed_out"] - set f [tls::socket -server accept 2828] + set f [tls::socket -server accept 8828] proc accept {file addr port} { global x set x done close $file } @@ -655,11 +658,11 @@ puts $x } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x - if {[catch {tls::socket 127.0.0.1 2828} msg]} { + if {[catch {tls::socket 127.0.0.1 8828} msg]} { set x $msg } else { lappend x [gets $f] close $msg } @@ -672,11 +675,11 @@ removeFile script set f [open script w] puts $f { package require tls } - puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2828 \]" + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]" puts $f { puts ready gets stdin close $f } @@ -683,11 +686,11 @@ close $f set f [open "|[list $::tcltest::tcltest script]" r+] gets $f set x [list [catch {tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - -server accept 2828} msg] \ + -server accept 8828} msg] \ $msg] puts $f bye close $f set x } {1 {couldn't open socket: address already in use}} @@ -700,11 +703,11 @@ set t1 [after 30000 "set x timed_out"] set t2 [after 31000 "set x timed_out"] set t3 [after 32000 "set x timed_out"] set counter 0 } - puts $f "set s \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2828 \]" + puts $f "set s \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]" puts $f { proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line } @@ -731,19 +734,19 @@ close $f set f [open "|[list $::tcltest::tcltest script]" r+] set x [gets $f] set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - 127.0.0.1 2828] + 127.0.0.1 8828] fconfigure $s1 -buffering line set s2 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - 127.0.0.1 2828] + 127.0.0.1 8828] fconfigure $s2 -buffering line set s3 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - 127.0.0.1 2828] + 127.0.0.1 8828] fconfigure $s3 -buffering line for {set i 0} {$i < 100} {incr i} { puts $s1 hello,s1 gets $s1 puts $s2 hello,s2 @@ -764,11 +767,11 @@ set f [open script w] puts $f { package require tls gets stdin } - puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 2828 \]" + puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8828 \]" puts $f { fconfigure $s -buffering line for {set i 0} {$i < 100} {incr i} { puts $s hello gets $s @@ -801,11 +804,11 @@ set t1 [after 30000 "set x timed_out"] set t2 [after 31000 "set x timed_out"] set t3 [after 32000 "set x timed_out"] set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2828] + -server accept 8828] puts $p1 open puts $p2 open puts $p3 open vwait x vwait x @@ -868,20 +871,20 @@ removeFile script set f [open script w] puts $f { package require tls gets stdin - tls::socket 127.0.0.1 2848 + tls::socket 127.0.0.1 8848 } close $f set f [open "|[list $::tcltest::tcltest script]" r+] proc bgerror args { global x set x $args } proc accept {s a p} {expr 10 / 0} - set s [tls::socket -server accept 2848] + set s [tls::socket -server accept 8848] puts $f hello close $f set timer [after 10000 "set x timed_out"] vwait x after cancel $timer @@ -896,11 +899,11 @@ removeFile script set f [open script w] puts $f { package require tls } - puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2820" + puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8820" puts $f { proc accept args { global x set x done } @@ -912,17 +915,17 @@ close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - 127.0.0.1 2820] + 127.0.0.1 8820] set p [fconfigure $s -peername] close $s close $f set l "" lappend l [string compare [lindex $p 0] 127.0.0.1] - lappend l [string compare [lindex $p 2] 2820] + lappend l [string compare [lindex $p 2] 8820] lappend l [llength $p] } {0 0 3} # bug report #5812 fconfigure doesn't return value for '-sockname' @@ -930,11 +933,11 @@ removeFile script set f [open script w] puts $f { package require tls } - puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2821" + puts $f "tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8821" puts $f { proc accept args { global x set x done } @@ -946,24 +949,24 @@ close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - 127.0.0.1 2821] + 127.0.0.1 8821] set p [fconfigure $s -sockname] close $s close $f set l "" lappend l [llength $p] lappend l [lindex $p 0] - lappend l [string equal [lindex $p 2] 2821] + lappend l [string equal [lindex $p 2] 8821] } {3 127.0.0.1 0} test tlsIO-7.3 {testing socket specific options} {socket} { set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2822] + -server accept 8822] set l [fconfigure $s] close $s update llength $l } 12 @@ -971,50 +974,50 @@ # bug report #5812 fconfigure doesn't return value for '-sockname' test tlsIO-7.4 {testing socket specific options} {knownBug socket} { set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2823] + -server accept 8823] proc accept {s a p} { global x set x [fconfigure $s -sockname] close $s } set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - [info hostname] 2823] + [info hostname] 8823] set timer [after 10000 "set x timed_out"] vwait x after cancel $timer close $s close $s1 set l "" lappend l [lindex $x 2] [llength $x] -} {2823 3} +} {8823 3} # bug report #5812 fconfigure doesn't return value for '-sockname' test tlsIO-7.5 {testing socket specific options} {knownBug socket unixOrPc} { set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2829] + -server accept 8829] proc accept {s a p} { global x set x [fconfigure $s -sockname] close $s } set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - 127.0.0.1 2829] + 127.0.0.1 8829] set timer [after 10000 "set x timed_out"] vwait x after cancel $timer close $s close $s1 set l "" lappend l [lindex $x 0] [lindex $x 2] [llength $x] -} {127.0.0.1 2829 3} +} {127.0.0.1 8829 3} test tlsIO-8.1 {testing -async flag on sockets} {unexplainedHang socket} { # test seems to hang -- awb 6/2/2000 # NOTE: This test may fail on some Solaris 2.4 systems. If it does, # check that you have these patches installed (using showrev -p): @@ -1030,20 +1033,20 @@ # problem, please email jyl@eng.sun.com. We have not observed this # failure on Solaris 2.5, so another option (instead of installing # these patches) is to upgrade to Solaris 2.5. set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2830] + -server accept 8830] proc accept {s a p} { global x puts $s bye close $s set x done } set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - -async [info hostname] 2830] + -async [info hostname] 8830] vwait x set z [gets $s1] close $s close $s1 set z @@ -1072,14 +1075,14 @@ fconfigure $s -buffering none -blocking off fileevent $s readable [list readlittle $s] } set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2831] + -server accept 8831] set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - [info hostname] 2831] + [info hostname] 8831] puts -nonewline $c 01234567890123456789012345678901234567890123456789 close $c set timer [after 10000 "set done timed_out"] vwait done after cancel $timer @@ -1094,11 +1097,11 @@ for {set i 0} {$i < 16} {incr i} { set secondblock "b$secondblock$secondblock" } set l [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2832] + -server accept 8832] proc accept {s a p} { fconfigure $s -blocking 0 -translation lf -buffersize 16384 \ -buffering line fileevent $s readable "readable $s" } @@ -1117,11 +1120,11 @@ puts -nonewline $s $secondblock close $s } set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - [info hostname] 2832] + [info hostname] 8832] fconfigure $s -blocking 0 -trans lf -buffering line set count 0 puts $s hello proc readit {s} { global count done @@ -1171,14 +1174,14 @@ fconfigure $s -buffering line -translation lf fileevent $s writable "write_then_close $s" } set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2833] + -server accept 8833] set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - [info hostname] 2833] + [info hostname] 8833] fconfigure $c -blocking off -buffering line -translation lf fileevent $c readable "count_to_eof $c" set timer [after 1000 timerproc] vwait done close $s @@ -1190,15 +1193,15 @@ test tlsIO-10.1 {testing socket accept callback error handling} {socket} { set goterror 0 proc bgerror args {global goterror; set goterror 1} set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2898] + -server accept 8898] proc accept {s a p} {close $s; error} set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - 127.0.0.1 2898] + 127.0.0.1 8898] vwait goterror close $s close $c set goterror } 1 @@ -1212,20 +1215,20 @@ sendCommand { set socket9_1_test_server [tls::socket -server accept \ -certfile $serverCert \ -cafile $caCert \ -keyfile $serverKey \ - 2834] + 8834] proc accept {s a p} { puts $s done tls::handshake $s close $s } } set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2834] + $remoteServerIP 8834] set r [gets $s] close $s sendCommand {close $socket9_1_test_server} set r } done @@ -1237,27 +1240,27 @@ sendCommand "set serverKey $serverKey" sendCommand "set clientKey $clientKey" if {[info exists port]} { incr port } else { - set port [expr 2048 + [pid]%1024] + set port [expr $tlsServerPort + [pid]%1024] } sendCommand { set socket9_2_test_server [tls::socket -server accept \ -certfile $serverCert \ -cafile $caCert \ -keyfile $serverKey \ - 2835] + 8835] proc accept {s a p} { tls::handshake $s puts $s $p close $s } } set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - -myport $port $remoteServerIP 2835] + -myport $port $remoteServerIP 8835] set r [gets $s] close $s sendCommand {close $socket9_2_test_server} if {$r == $port} { set result ok @@ -1268,11 +1271,11 @@ } ok test tlsIO-11.3 {trying to connect, no server} {socket doTestsWithRemoteServer} { set status ok if {![catch {set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIp 2836]}]} { + $remoteServerIp 8836]}]} { if {![catch {gets $s}]} { set status broken } close $s } @@ -1291,11 +1294,11 @@ global serverKey set socket10_6_test_server [tls::socket \ -certfile $serverCert \ -cafile $caCert \ -keyfile $serverKey \ - -server accept 2836] + -server accept 8836] proc accept {s a p} { tls::handshake $s fileevent $s readable [list echo $s] fconfigure $s -buffering line -translation crlf } @@ -1308,11 +1311,11 @@ } } } set f [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2836] + $remoteServerIP 8836] fconfigure $f -translation crlf -buffering line puts $f hello set r [gets $f] close $f sendCommand {close $socket10_6_test_server} @@ -1328,11 +1331,11 @@ sendCommand { set socket10_7_test_server [tls::socket -server accept \ -certfile $serverCert \ -cafile $caCert \ -keyfile $serverKey \ - 2836] + 8836] proc accept {s a p} { tls::handshake $s fileevent $s readable [list echo $s] fconfigure $s -buffering line -translation crlf } @@ -1345,11 +1348,11 @@ } } } set f [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2836] + $remoteServerIP 8836] fconfigure $f -translation crlf -buffering line for {set cnt 0} {$cnt < 50} {incr cnt} { puts $f "hello, $cnt" if {[string compare [gets $f] "hello, $cnt"] != 0} { break @@ -1360,22 +1363,22 @@ set cnt } 50 # Macintosh sockets can have more than one server per port if {$tcl_platform(platform) == "macintosh"} { - set conflictResult {0 2836} + set conflictResult {0 8836} } else { set conflictResult {1 {couldn't open socket: address already in use}} } test tlsIO-11.6 {socket conflict} {socket doTestsWithRemoteServer} { set s1 [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2836] + -server accept 8836] if {[catch {set s2 [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2836]} msg]} { + -server accept 8836]} msg]} { set result [list 1 $msg] } else { set result [list 0 [lindex [fconfigure $s2 -sockname] 2]] close $s2 } @@ -1387,11 +1390,11 @@ sendCommand { set socket10_9_test_server [tls::socket \ -certfile [file join [pwd] certs server.pem] \ -cafile [file join [pwd] certs caFile.pem] \ -keyfile [file join [pwd] certs skey.pem] \ - -server accept 2836] + -server accept 8836] proc accept {s a p} { # handshake locks up the three synchronous clients # tls::handshake $s fconfigure $s -buffering line fileevent $s readable [list echo $s] @@ -1405,19 +1408,19 @@ } } } set s1 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2836] + $remoteServerIP 8836] fconfigure $s1 -buffering line set s2 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2836] + $remoteServerIP 8836] fconfigure $s2 -buffering line set s3 [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2836] + $remoteServerIP 8836] fconfigure $s3 -buffering line for {set i 0} {$i < 100} {incr i} { puts $s1 hello,s1 gets $s1 puts $s2 hello,s2 @@ -1480,11 +1483,11 @@ } {4003 {} 1 4004 {} 1 4005 {} 1} test tlsIO-11.9 {accept callback error} {socket doTestsWithRemoteServer} { set s [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2836] + -server accept 8836] proc accept {s a p} {expr 10 / 0} proc bgerror args { global x set x $args } @@ -1497,11 +1500,11 @@ set peername [fconfigure $callerSocket -peername] set s [tls::socket \ -certfile $clientCert \ -cafile $caCert \ -keyfile $clientKey \ - [lindex $peername 0] 2836] + [lindex $peername 0] 8836] close $s }} msg]} { close $s error $msg } @@ -1522,24 +1525,24 @@ sendCommand { set socket10_12_test_server [tls::socket \ -certfile $serverCert \ -cafile $caCert \ -keyfile $serverKey \ - -server accept 2836] + -server accept 8836] proc accept {s a p} {close $s} } set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2836] + $remoteServerIP 8836] set p [fconfigure $s -peername] set n [fconfigure $s -sockname] set l "" lappend l [lindex $p 2] [llength $p] [llength $p] close $s sendCommand {close $socket10_12_test_server} set l -} {2836 3 3} +} {8836 3 3} test tlsIO-11.11 {testing spurious events} {unexplainedHang socket doTestsWithRemoteServer} { # hangs sendCommand "set caCert $caCert" sendCommand "set serverCert $serverCert" @@ -1549,11 +1552,11 @@ sendCommand { set socket10_13_test_server [tls::socket \ -certfile $serverCert \ -cafile $caCert \ -keyfile $serverKey \ - -server accept 2836] + -server accept 8836] proc accept {s a p} { tls::handshake $s fconfigure $s -translation "auto lf" after 100 writesome $s } @@ -1581,11 +1584,11 @@ incr len [string length $l] } } set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2836] + $remoteServerIP 8836] fileevent $c readable "readlittle $c" set timer [after 10000 "set done timed_out"] vwait done after cancel $timer sendCommand {close $socket10_13_test_server} @@ -1620,19 +1623,19 @@ sendCommand { set socket10_14_test_server [tls::socket \ -certfile $serverCert \ -cafile $caCert \ -keyfile $serverKey \ - -server accept 2836] + -server accept 8836] proc accept {s a p} { tls::handshake $s after 100 close $s } } set c [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2836] + $remoteServerIP 8836] fileevent $c readable "count_up $c" set after_id [after 1000 timed_out] vwait done sendCommand {close $socket10_14_test_server} set done @@ -1665,11 +1668,11 @@ } set l [tls::socket \ -certfile $serverCert \ -cafile $caCert \ -keyfile $serverKey \ - -server accept 2845] + -server accept 8845] proc accept {s a p} { tls::handshake $s fconfigure $s -blocking 0 -translation lf -buffersize 16384 \ -buffering line fileevent $s readable "readable $s" @@ -1690,11 +1693,11 @@ close $s } } set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - $remoteServerIP 2845] + $remoteServerIP 8845] fconfigure $s -blocking 0 -trans lf -buffering line set count 0 puts $s hello fileevent $s readable "readit $s" set timer [after 10000 "set done timed_out"] @@ -1728,11 +1731,11 @@ puts $f [list set tclsh [info nameofexecutable]] puts $f { package require tcltest package require tls } - puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2828 \]" + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8828 \]" puts $f { proc accept { file addr port } { close $file } # exec $::tcltest::tcltest script1 & @@ -1752,11 +1755,11 @@ # If we can still connect to the server, the socket got inherited. if {[catch {tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - 127.0.0.1 2828} msg]} { + 127.0.0.1 8828} msg]} { set x {server socket was not inherited} } else { close $msg set x {server socket was inherited} } @@ -1788,11 +1791,11 @@ set f [open script2 w] puts $f [list set tclsh [info nameofexecutable]] puts $f { package require tls } - puts $f "set f \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 2829 \]" + puts $f "set f \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8829 \]" puts $f { exec $tclsh script1 & puts $f testing flush $f after 1000 exit @@ -1802,11 +1805,11 @@ # Create the server socket set server [tls::socket \ -certfile $serverCert -cafile $caCert -keyfile $serverKey \ - -server accept 2829] + -server accept 8829] proc accept { file host port } { # When the client connects, establish the read handler global server close $server @@ -1874,11 +1877,11 @@ set f [open script2 w] puts $f [list set tclsh [info nameofexecutable]] puts $f { package require tls } - puts $f "catch {set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2930 \]}" + puts $f "catch {set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 8930 \]}" puts $f { proc accept { file host port } { global tclsh puts $file {test data on socket} exec $tclsh script1 & @@ -1896,11 +1899,11 @@ after 1000 set ok_to_proceed 1 vwait ok_to_proceed set f [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ - 127.0.0.1 2930] + 127.0.0.1 8930] fconfigure $f -buffering full -blocking 0 fileevent $f readable [list getdata $f] # If the socket is still open after 5 seconds, the script1 process # must have inherited the accepted socket. @@ -1946,11 +1949,11 @@ removeFile script threadReap makeFile { package require tls - set f [tls::socket -server accept 2828] + set f [tls::socket -server accept 8828] proc accept {s a p} { fileevent $s readable [list echo $s] fconfigure $s -buffering line } proc echo {s} { @@ -1976,11 +1979,11 @@ # create a thread set serverthread [testthread create { source script } ] update after 1000 - set s [tls::socket 127.0.0.1 2828] + set s [tls::socket 127.0.0.1 8828] fconfigure $s -buffering line catch { puts $s "hello" gets $s result