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
# 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