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.14 2000/06/08 00:06:40 aborr Exp $
# RCS: @(#) $Id: tlsIO.test,v 1.14.2.1 2000/07/11 04:58:46 hobbs 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
|
| ︙ | | |
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
+
|
# Load the tls package
package require tls
set tlsServerPort 8048
set certsDir [file join [file dirname [info script]] certs]
#set certsDir ~hobbs/cvs/tls/tests/certs
set serverCert [file join $certsDir server.pem]
set clientCert [file join $certsDir client.pem]
set caCert [file join $certsDir cacert.pem]
set serverKey [file join $certsDir skey.pem]
set clientKey [file join $certsDir ckey.pem]
|
| ︙ | | |
330
331
332
333
334
335
336
337
338
339
340
341
342
343
|
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
|
+
+
|
global port
if {[catch {tls::socket -myport $port \
-certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 8829} sock]} {
set x $sock
catch {close [tls::socket 127.0.0.1 8829]}
} else {
# HOBBS handshake shouldn't be necessary
tls::handshake $sock
puts $sock hello
flush $sock
lappend x [gets $f]
close $sock
}
close $f
set x
|
| ︙ | | |
367
368
369
370
371
372
373
374
375
376
377
378
379
380
|
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
|
+
+
|
set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
if {[catch {tls::socket -myaddr 127.0.0.1 \
-certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 8830} sock]} {
set x $sock
} else {
# HOBBS handshake shouldn't be necessary
tls::handshake $sock
puts $sock hello
catch {flush $sock}
lappend x [gets $f]
close $sock
}
close $f
set x
|
| ︙ | | |
403
404
405
406
407
408
409
410
411
412
413
414
415
416
|
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
|
+
+
|
close $f
set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
if {[catch {tls::socket -certfile $clientCert -cafile $caCert \
-keyfile $clientKey [info hostname] 8831} sock]} {
set x $sock
} else {
# HOBBS handshake shouldn't be necessary
tls::handshake $sock
puts $sock hello
flush $sock
lappend x [gets $f]
close $sock
}
close $f
set x
|
| ︙ | | |
439
440
441
442
443
444
445
446
447
448
449
450
451
452
|
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
|
+
+
|
close $f
set f [open "|[list $::tcltest::tcltest script]" r]
gets $f x
if {[catch {tls::socket -certfile $clientCert -cafile $caCert \
-keyfile $clientKey 127.0.0.1 8832} sock]} {
set x $sock
} else {
# HOBBS handshake shouldn't be necessary
tls::handshake $sock
puts $sock hello
flush $sock
lappend x [gets $f]
close $sock
}
close $f
set x
|
| ︙ | | |
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
|
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
|
-
+
|
close $s2
close $s3
lappend x [gets $f]
close $f
set x
} {ready done}
test tlsIO-4.1 {server with several clients} {socket stdio} {
test tlsIO-4.1 {server with several clients} {hangsHobbs socket stdio} {
removeFile script
set f [open script w]
puts $f {
package require tls
gets stdin
}
puts $f "set s \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 8828 \]"
|
| ︙ | | |