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-1999 by Scriptics Corporation.
#
# 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.4 2000/06/02 21:44:59 awb Exp $
# RCS: @(#) $Id: tlsIo.test,v 1.5 2000/06/02 21:50:44 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
|
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
|
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
|
-
+
+
-
+
+
-
+
+
+
|
lappend x [gets $f]
close $sock
}
close $f
set x
} [list ready "hello $port"]
test socket-2.3 {tcp connection with client interface specified} {socket stdio pcCrash} {
test socket-2.3 {tcp connection with client interface specified} {socket stdio} {
removeFile script
set f [open script w]
puts $f {
package require tls
set timer [after 2000 "set x done"]
}
set f [tls::socket -server accept 2830]
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2830 \]"
puts $f {
proc accept {file addr port} {
global x
puts "[gets $file] $addr"
close $file
set x done
}
puts ready
vwait x
after cancel $timer
close $f
}
close $f
set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
if {[catch {tls::socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {
if {[catch {tls::socket -myaddr 127.0.0.1 \
-certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 2830} sock]} {
set x $sock
} else {
puts $sock hello
catch {flush $sock}
lappend x [gets $f]
close $sock
}
|