@@ -8,11 +8,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # # 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.3 2000/06/02 20:45:38 awb Exp $ +# RCS: @(#) $Id: tlsIo.test,v 1.4 2000/06/02 21:44:59 awb Exp $ # Running socket tests with a remote server: # ------------------------------------------ # # Some tests in socket.test depend on the existence of a remote server to @@ -67,10 +67,16 @@ namespace import -force ::tcltest::* } # Load the tls package package require tls + +set serverCert [file join $::tcltest::testsDirectory certs server.pem] +set clientCert [file join $::tcltest::testsDirectory certs client.pem] +set caCert [file join $::tcltest::testsDirectory certs cacert.pem] +set serverKey [file join $::tcltest::testsDirectory certs skey.pem] +set clientKey [file join $::tcltest::testsDirectory certs ckey.pem] # Some tests require the testthread command set ::tcltest::testConstraints(testthread) \ [expr {[info commands testthread] != {}}] @@ -284,17 +290,19 @@ incr port } else { set port [expr 2048 + [pid]%1024] } -test socket-2.2 {tcp connection with client port specified} {socket stdio pcCrash} { +test socket-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"] - set f [tls::socket -server accept 2829] + } + puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2829 \]" + puts $f { proc accept {file addr port} { global x puts "[gets $file] $port" close $file set x done @@ -306,14 +314,15 @@ } close $f set f [open "|[list $::tcltest::tcltest script]" r] gets $f x global port - if {[catch {tls::socket -myport $port 127.0.0.1 2829} sock]} { + if {[catch {tls::socket -myport $port \ + -certfile $clientCert -cafile $caCert \ + -keyfile $clientKey 127.0.0.1 2829} sock]} { set x $sock - close [tls::socket 127.0.0.1 2829] - puts stderr $sock + catch {close [tls::socket 127.0.0.1 2829]} } else { puts $sock hello flush $sock lappend x [gets $f] close $sock @@ -345,11 +354,11 @@ gets $f x if {[catch {tls::socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} { set x $sock } else { puts $sock hello - flush $sock + catch {flush $sock} lappend x [gets $f] close $sock } close $f set x