Diff

Differences From Artifact [0c7ac98f84]:

To Artifact [5049a14c6a]:


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.6 2000/06/02 22:26:12 awb Exp $
# 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
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 $remoteServerIP \
						$remoteServerPort]}] != 0} {
    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 $remoteServerIP \
		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
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 disappaered"
		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
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 pcCrash} {
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 2830]
    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 \
    set cs [tls::socket [info hostname] 2830]
	-keyfile $clientKey [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} {
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 -server accept 2400]
    set s [tls::socket -require 0 -request 0 -server accept -certfile $serverCert -cafile $caCert \
	-keyfile $serverKey 2400]
    set sock ""
    set s2 [tls::socket 127.0.0.1 2400]
    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
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 2834]
	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 $remoteServerIP 2834]
    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 2835]
	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 \
    set s [tls::socket -myport $port $remoteServerIP 2835]
	    -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