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.6 2000/06/02 22:26:12 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
|
|
|
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
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
|
# 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 $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 $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
}
}
# 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."
|
|
>
>
|
|
>
>
>
|
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
194
195
196
197
198
199
200
201
|
error "remote server disappeared: $msg"
}
set resp ""
while {1} {
set line [gets $commandSocket]
if {[eof $commandSocket]} {
error "remote server disappaered"
}
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]
}
|
|
|
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
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
|
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 pcCrash} {
set done 0
set timer [after 20000 "set done timed_out"]
set ss [tls::socket -server accept 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 [info hostname] 2830]
puts $cs hello
close $cs
vwait done
after cancel $timer
set done
} 1
test socket-2.11 {detecting new data} {socket pcCrash} {
proc accept {s a p} {
global sock
set sock $s
}
set s [tls::socket -server accept 2400]
set sock ""
set s2 [tls::socket 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]
|
|
|
>
>
|
<
>
>
|
>
>
>
>
>
|
>
|
>
|
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
1127
1128
1129
1130
1131
1132
1133
1134
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
|
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 2834]
proc accept {s a p} {
puts $s done
close $s
}
}
set s [tls::socket $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 2835]
proc accept {s a p} {
puts $s $p
close $s
}
}
set s [tls::socket -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
|
|
>
>
>
>
>
|
>
>
>
|
>
>
>
>
>
>
|
|
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
|
︙ | | | ︙ | |