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.3 2000/06/02 20:45:38 awb Exp $
# RCS: @(#) $Id: tlsIo.test,v 1.4 2000/06/02 21:44:59 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
|
| ︙ | | |
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
+
+
+
+
+
+
|
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
# Load the tls package
package require tls
set serverCert [file join $::tcltest::testsDirectory certs server.pem]
set clientCert [file join $::tcltest::testsDirectory certs client.pem]
set caCert [file join $::tcltest::testsDirectory certs cacert.pem]
set serverKey [file join $::tcltest::testsDirectory certs skey.pem]
set clientKey [file join $::tcltest::testsDirectory certs ckey.pem]
# Some tests require the testthread command
set ::tcltest::testConstraints(testthread) \
[expr {[info commands testthread] != {}}]
#
|
| ︙ | | |
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
|
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
|
-
+
+
-
+
+
-
+
+
+
-
+
-
|
if [info exists port] {
incr port
} else {
set port [expr 2048 + [pid]%1024]
}
test socket-2.2 {tcp connection with client port specified} {socket stdio pcCrash} {
test socket-2.2 {tcp connection with client port 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 2829]
puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 2829 \]"
puts $f {
proc accept {file addr port} {
global x
puts "[gets $file] $port"
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
global port
if {[catch {tls::socket -myport $port 127.0.0.1 2829} sock]} {
if {[catch {tls::socket -myport $port \
-certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 2829} sock]} {
set x $sock
close [tls::socket 127.0.0.1 2829]
catch {close [tls::socket 127.0.0.1 2829]}
puts stderr $sock
|
| ︙ | | |
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
|
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
|
-
+
|
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]} {
set x $sock
} else {
puts $sock hello
flush $sock
catch {flush $sock}
lappend x [gets $f]
close $sock
}
close $f
set x
} {ready {hello 127.0.0.1}}
|
| ︙ | | |