Overview
Comment: | Add remote server for tls testing. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
79208b498d3993924b2f2465b91e70f9 |
User & Date: | awb on 2000-06-03 00:20:02 |
Other Links: | manifest | tags |
Context
2000-06-03
| ||
02:30 | *** empty log message *** check-in: 4bf039c9a5 user: awb tags: trunk | |
00:20 | Add remote server for tls testing. check-in: 79208b498d user: awb tags: trunk | |
2000-06-02
| ||
22:26 | Fix some more tests. check-in: f1e28695f2 user: awb tags: trunk | |
Changes
Added tests/remote.tcl version [b409bf0b71].
Modified tests/tlsIo.test from [0c7ac98f84] to [5049a14c6a].
1 2 3 4 5 6 7 8 9 10 11 12 | # Commands tested in this file: socket. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1994-1996 Sun Microsystems, Inc. # 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. # | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | # Commands tested in this file: socket. # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1994-1996 Sun Microsystems, Inc. # 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.7 2000/06/03 00:20:02 awb Exp $ # Running socket tests with a remote server: # ------------------------------------------ # # Some tests in socket.test depend on the existence of a remote server to # 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 |
︙ | ︙ | |||
120 121 122 123 124 125 126 | # platforms that do not support exec, the remote server must be started # by the user before running the tests. set remoteProcChan "" set commandSocket "" if {$doTestsWithRemoteServer} { catch {close $commandSocket} | | > > | | > > > | 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 | # platforms that do not support exec, the remote server must be started # by the user before running the tests. set remoteProcChan "" set commandSocket "" if {$doTestsWithRemoteServer} { catch {close $commandSocket} if {[catch {set commandSocket [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ $remoteServerIP \ $remoteServerPort]}] != 0} { if {[info commands exec] == ""} { set noRemoteTestReason "can't exec" set doTestsWithRemoteServer 0 } else { set remoteServerIP 127.0.0.1 set remoteFile [file join [pwd] remote.tcl] if {[catch {set remoteProcChan \ [open "|[list $::tcltest::tcltest $remoteFile \ -serverIsSilent \ -port $remoteServerPort \ -address $remoteServerIP]" \ w+]} \ msg] == 0} { after 1000 if {[catch {set commandSocket [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ $remoteServerIP \ $remoteServerPort]} msg] == 0} { fconfigure $commandSocket -translation crlf -buffering line } else { set noRemoteTestReason $msg set doTestsWithRemoteServer 0 } } else { set noRemoteTestReason "$msg $::tcltest::tcltest" set doTestsWithRemoteServer 0 } } } else { fconfigure $commandSocket -translation crlf -buffering line } } puts stdout "commandSocket: $commandSocket" # Some tests are run only if we are doing testing against a remote server. set ::tcltest::testConstraints(doTestsWithRemoteServer) $doTestsWithRemoteServer if {$doTestsWithRemoteServer == 0} { if {[string first s $::tcltest::verbose] != -1} { puts "Skipping tests with remote server. See tests/socket.test for" puts "information on how to run remote server." |
︙ | ︙ | |||
187 188 189 190 191 192 193 | error "remote server disappeared: $msg" } set resp "" while {1} { set line [gets $commandSocket] if {[eof $commandSocket]} { | | | 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 | error "remote server disappeared: $msg" } set resp "" while {1} { set line [gets $commandSocket] if {[eof $commandSocket]} { error "remote server disappeared" } if {[string compare $line "--Marker--Marker--Marker--"] == 0} { if {[string compare [lindex $resp 0] error] == 0} { error [lindex $resp 1] } else { return [lindex $resp 1] } |
︙ | ︙ | |||
565 566 567 568 569 570 571 | invoked from within "eval ::socket $sopts" (procedure "tls::socket" line 62) invoked from within "tls::socket -server accept 2828" (file "script" line 1)}} | | | > > | < > > | > > > > > | > | > | 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 | invoked from within "eval ::socket $sopts" (procedure "tls::socket" line 62) invoked from within "tls::socket -server accept 2828" (file "script" line 1)}} test socket-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] proc accept {s a p} { global ss close $ss fileevent $s readable "readit $s" fconfigure $s -trans lf } proc readit {s} { global done gets $s close $s set done 1 } set cs [tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey [info hostname] 2830] close $cs vwait done after cancel $timer set done } 1 test socket-2.11 {detecting new data} {socket knownBug} { proc accept {s a p} { global sock set sock $s set f [open awb.log w] puts $f [catch {tls::handshake $sock} err] puts $f "err: $err" puts $f "[tls::status $sock]" close $s } set s [tls::socket -require 0 -request 0 -server accept -certfile $serverCert -cafile $caCert \ -keyfile $serverKey 2400] set sock "" set s2 [tls::socket -certfile $clientCert -cafile $caCert \ -keyfile $clientKey 127.0.0.1 2400] vwait sock puts $s2 one flush $s2 after 500 fconfigure $sock -blocking 0 set result [gets $sock] lappend result [gets $sock] |
︙ | ︙ | |||
1120 1121 1122 1123 1124 1125 1126 | close $s close $c set goterror } 1 test socket-11.1 {tcp connection} {socket doTestsWithRemoteServer} { sendCommand { | | > > > > > | > > > | > > > > > > | | 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 | close $s close $c set goterror } 1 test socket-11.1 {tcp connection} {socket doTestsWithRemoteServer} { sendCommand { set socket9_1_test_server [tls::socket -server accept \ -certfile [file join [pwd] certs server.pem] \ -cafile [file join [pwd] certs caFile.pem] \ -keyfile [file join [pwd] certs skey.pem] \ 2834] 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] set r [gets $s] close $s sendCommand {close $socket9_1_test_server} set r } done test socket-11.2 {client specifies its port} {socket doTestsWithRemoteServer} { if {[info exists port]} { incr port } else { set port [expr 2048 + [pid]%1024] } sendCommand { set socket9_2_test_server [tls::socket -server accept \ -certfile [file join [pwd] certs server.pem] \ -cafile [file join [pwd] certs caFile.pem] \ -keyfile [file join [pwd] certs skey.pem] \ 2835] proc accept {s a p} { puts $s $p close $s } } set s [tls::socket \ -certfile $clientCert -cafile $caCert -keyfile $clientKey \ -myport $port $remoteServerIP 2835] set r [gets $s] close $s sendCommand {close $socket9_2_test_server} if {$r == $port} { set result ok } else { set result broken |
︙ | ︙ |