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
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 $
# 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
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 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
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} {
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
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"
    }
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"
1138
1139
1140
1141
1142
1143
1144
1145

1146
1147
1148
1149
1150
1151
1152
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} {empty socket} {
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
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} {empty socket doTestsWithRemoteServer} {
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
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} {empty socket doTestsWithRemoteServer} {
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
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} \
	{empty socket doTestsWithRemoteServer} {
	{socket doTestsWithRemoteServer} {
    # hangs on Linux
    removeFile script1
    removeFile script2

    set f [open script1 w]
    puts $f {
	after 10000 exit