Diff

Differences From Artifact [1dc1216bd3]:

To Artifact [d89e7e40f3]:


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