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.5 2000/06/05 22:57:58 stanton 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.6 2000/06/05 23:31:17 aborr 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
|
︙ | | | ︙ | |
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
|
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}
test tlsIO-8.1 {testing -async flag on sockets} {empty 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):
#
# 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,
# 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,
# 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03,
|
|
|
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
|
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}
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):
#
# 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,
# 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,
# 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03,
|
︙ | | | ︙ | |
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
|
vwait x
set z [gets $s1]
close $s
close $s1
set z
} bye
test tlsIO-9.1 {testing spurious events} {empty socket} {
# locks up
set len 0
set spurious 0
set done 0
proc readlittle {s} {
global spurious done len
set l [read $s 1]
|
|
|
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
|
vwait x
set z [gets $s1]
close $s
close $s1
set z
} bye
test tlsIO-9.1 {testing spurious events} {unexplainedHang socket} {
# locks up
set len 0
set spurious 0
set done 0
proc readlittle {s} {
global spurious done len
set l [read $s 1]
|
︙ | | | ︙ | |
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
|
test tlsIO-9.2 {testing async write, fileevents, flush on close} {socket} {
set firstblock ""
for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
set secondblock ""
for {set i 0} {$i < 16} {incr i} {
set secondblock "b$secondblock$secondblock"
}
puts "firstblock = [string length $firstblock]"
puts "secondblock = [string length $secondblock]"
set l [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-server accept 2832]
proc accept {s a p} {
fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-buffering line
fileevent $s readable "readable $s"
|
<
<
|
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
|
test tlsIO-9.2 {testing async write, fileevents, flush on close} {socket} {
set firstblock ""
for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
set secondblock ""
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]
proc accept {s a p} {
fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
-buffering line
fileevent $s readable "readable $s"
|
︙ | | | ︙ | |
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
|
set timer [after 10000 "set done timed_out"]
vwait done
after cancel $timer
close $l
set count
} 65566
test tlsIO-9.3 {testing EOF stickyness} {empty socket} {
# hangs
proc count_to_eof {s} {
global count done timer
set l [gets $s]
if {[eof $s]} {
incr count
if {$count > 9} {
|
|
|
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
|
set timer [after 10000 "set done timed_out"]
vwait done
after cancel $timer
close $l
set count
} 65566
test tlsIO-9.3 {testing EOF stickyness} {unexplainedHang socket} {
# hangs
proc count_to_eof {s} {
global count done timer
set l [gets $s]
if {[eof $s]} {
incr count
if {$count > 9} {
|
︙ | | | ︙ | |
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
|
close $s1
close $s2
close $s3
sendCommand {close $socket10_9_test_server}
set i
} 100
test tlsIO-11.8 {client with several servers} {empty socket doTestsWithRemoteServer} {
# this one seems to hang -- awb 6/2/2000
sendCommand {
set s1 [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 4003" 4003]
|
|
|
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
|
close $s1
close $s2
close $s3
sendCommand {close $socket10_9_test_server}
set i
} 100
test tlsIO-11.8 {client with several servers} {socket doTestsWithRemoteServer} {
# this one seems to hang -- awb 6/2/2000
sendCommand {
set s1 [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 4003" 4003]
|
︙ | | | ︙ | |
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
|
set l ""
lappend l [lindex $p 2] [llength $p] [llength $p]
close $s
sendCommand {close $socket10_12_test_server}
set l
} {2836 3 3}
test tlsIO-11.11 {testing spurious events} {empty socket doTestsWithRemoteServer} {
# hangs
sendCommand "set caCert $caCert"
sendCommand "set serverCert $serverCert"
sendCommand "set clientCert $clientCert"
sendCommand "set serverKey $serverKey"
sendCommand "set clientKey $clientKey"
sendCommand {
|
|
|
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
|
set l ""
lappend l [lindex $p 2] [llength $p] [llength $p]
close $s
sendCommand {close $socket10_12_test_server}
set l
} {2836 3 3}
test tlsIO-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
# hangs
sendCommand "set caCert $caCert"
sendCommand "set serverCert $serverCert"
sendCommand "set clientCert $clientCert"
sendCommand "set serverKey $serverKey"
sendCommand "set clientKey $clientKey"
sendCommand {
|
︙ | | | ︙ | |
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
|
}
removeFile script1
removeFile script2
set x
} {client socket was not inherited}
test tlsIO-12.3 {testing inheritance of accepted sockets} \
{empty socket doTestsWithRemoteServer} {
# hangs on Linux
removeFile script1
removeFile script2
set f [open script1 w]
puts $f {
after 10000 exit
|
|
|
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
|
}
removeFile script1
removeFile script2
set x
} {client socket was not inherited}
test tlsIO-12.3 {testing inheritance of accepted sockets} \
{socket doTestsWithRemoteServer} {
# hangs on Linux
removeFile script1
removeFile script2
set f [open script1 w]
puts $f {
after 10000 exit
|
︙ | | | ︙ | |