1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
# Commands tested in this file: socket. -*- tcl -*-
#
# 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.24 2015/06/06 09:07:08 apnadkarni 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
# can start the remote server on any machine reachable from the machine on
# which you want to run the socket tests, by issuing:
#
# tcltest remote.tcl -port 8048 # Or choose another port number.
#
# If the machine you are running the remote server on has several IP
# interfaces, you can choose which interface the server listens on for
# connections by specifying the -address command line flag, so:
#
# tcltest remote.tcl -address your.machine.com
#
# These options can also be set by environment variables. On Unix, you can
# type these commands to the shell from which the remote server is started:
#
# shell% setenv serverPort 8048
# shell% setenv serverAddress your.machine.com
#
# and subsequently you can start the remote server with:
#
# tcltest remote.tcl
#
# to have it listen on port 8048 on the interface your.machine.com.
#
# When the server starts, it prints out a detailed message containing its
# configuration information, and it will block until killed with a Ctrl-C.
# Once the remote server exists, you can run the tests in socket.test with
# the server by setting two Tcl variables:
#
# % set remoteServerIP <name or address of machine on which server runs>
# % set remoteServerPort 8048
#
# These variables are also settable from the environment. On Unix, you can:
#
# shell% setenv remoteServerIP machine.where.server.runs
# shell% setenv remoteServerPort 8048
#
# The preamble of the socket.test file checks to see if the variables are set
# either in Tcl or in the environment; if they are, it attempts to connect to
# the server. If the connection is successful, the tests using the remote
# server will be performed; otherwise, it will attempt to start the remote
# server (via exec) on platforms that support this, on the local host,
# listening at port 8048. If all fails, a message is printed and the tests
# using the remote server are not performed.
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
# Commands tested in this file: socket. -*- tcl -*-
#
# 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.24 2015/06/06 09:07:08 apnadkarni 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
# can start the remote server on any machine reachable from the machine on
# which you want to run the socket tests, by issuing:
#
# tcltest remote.tcl -port 8048 # Or choose another port number.
#
# If the machine you are running the remote server on has several IP
# interfaces, you can choose which interface the server listens on for
# connections by specifying the -address command line flag, so:
#
# tcltest remote.tcl -address your.machine.com
#
# These options can also be set by environment variables. On Unix, you can
# type these commands to the shell from which the remote server is started:
#
# shell% setenv serverPort 8048
# shell% setenv serverAddress your.machine.com
#
# and subsequently you can start the remote server with:
#
# tcltest remote.tcl
#
# to have it listen on port 8048 on the interface your.machine.com.
#
# When the server starts, it prints out a detailed message containing its
# configuration information, and it will block until killed with a Ctrl-C.
# Once the remote server exists, you can run the tests in socket.test with
# the server by setting two Tcl variables:
#
# % set remoteServerIP <name or address of machine on which server runs>
# % set remoteServerPort 8048
#
# These variables are also settable from the environment. On Unix, you can:
#
# shell% setenv remoteServerIP machine.where.server.runs
# shell% setenv remoteServerPort 8048
#
# The preamble of the socket.test file checks to see if the variables are set
# either in Tcl or in the environment; if they are, it attempts to connect to
# the server. If the connection is successful, the tests using the remote
# server will be performed; otherwise, it will attempt to start the remote
# server (via exec) on platforms that support this, on the local host,
# listening at port 8048. If all fails, a message is printed and the tests
# using the remote server are not performed.
|
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
|
proc echo {s} {
global i
set l [gets $s]
if {[eof $s]} {
global x
close $s
set x done
} else {
incr i
puts $s $l
}
}
set i 0
puts ready
set timer [after 20000 "set x done"]
|
|
|
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
|
proc echo {s} {
global i
set l [gets $s]
if {[eof $s]} {
global x
close $s
set x done
} else {
incr i
puts $s $l
}
}
set i 0
puts ready
set timer [after 20000 "set x done"]
|
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
|
}
}
proc timerproc {} {
global done count c
set done true
set count {timer went off, eof is not sticky}
close $c
}
set count 0
set done false
proc write_then_close {s} {
puts $s bye
close $s
}
proc accept {s a p} {
|
|
|
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
|
}
}
proc timerproc {} {
global done count c
set done true
set count {timer went off, eof is not sticky}
close $c
}
set count 0
set done false
proc write_then_close {s} {
puts $s bye
close $s
}
proc accept {s a p} {
|
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
|
gets $s3
}
close $s1
close $s2
close $s3
sendCommand {close $socket10_9_test_server}
set i
} 100
test tlsIO-11.8 {client with several servers} {socket doTestsWithRemoteServer} {
sendCertValues
sendCommand {
tls::init -certfile $serverCert -cafile $caCert -keyfile $serverKey
set s1 [tls::socket -server "accept 4003" 4003]
set s2 [tls::socket -server "accept 4004" 4004]
|
|
|
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
|
gets $s3
}
close $s1
close $s2
close $s3
sendCommand {close $socket10_9_test_server}
set i
} 100
test tlsIO-11.8 {client with several servers} {socket doTestsWithRemoteServer} {
sendCertValues
sendCommand {
tls::init -certfile $serverCert -cafile $caCert -keyfile $serverKey
set s1 [tls::socket -server "accept 4003" 4003]
set s2 [tls::socket -server "accept 4004" 4004]
|
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
|
proc echo {s} {
global i
set l [gets $s]
if {[eof $s]} {
global x
close $s
set x done
} else {
incr i
puts $s $l
}
}
set i 0
vwait x
close $f
# thread cleans itself up.
testthread exit
} script
# create a thread
set serverthread [testthread create { source script } ]
update
after 1000
set s [tls::socket 127.0.0.1 8828]
fconfigure $s -buffering line
catch {
puts $s "hello"
gets $s result
}
close $s
update
after 2000
lappend result [threadReap]
set result
} {hello 1}
test tlsIO-14.1 {test tls::unimport} {socket} {
list [catch {tls::unimport} msg] $msg
} {1 {wrong # args: should be "tls::unimport channel"}}
|
|
|
|
|
|
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
|
proc echo {s} {
global i
set l [gets $s]
if {[eof $s]} {
global x
close $s
set x done
} else {
incr i
puts $s $l
}
}
set i 0
vwait x
close $f
# thread cleans itself up.
testthread exit
} script
# create a thread
set serverthread [testthread create { source script } ]
update
after 1000
set s [tls::socket 127.0.0.1 8828]
fconfigure $s -buffering line
catch {
puts $s "hello"
gets $s result
}
close $s
update
after 2000
lappend result [threadReap]
set result
} {hello 1}
test tlsIO-14.1 {test tls::unimport} {socket} {
list [catch {tls::unimport} msg] $msg
} {1 {wrong # args: should be "tls::unimport channel"}}
|
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
|
test tls-bug58-1.0 {test protocol negotiation failure} {socket} {
# Following code is based on what was reported in bug #58. Prior
# to fix the program would crash with a segfault.
proc Accept {sock args} {
fconfigure $sock -blocking 0;
fileevent $sock readable [list Handshake $sock]
}
proc Handshake {sock} {
set ::done HAND
catch {tls::handshake $sock} msg
set ::done $msg
}
# NOTE: when doing an in-process client/server test, both sides need
# to be non-blocking for the TLS handshake
# Server - Only accept TLS 1.2
set s [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-request 0 -require 0 -ssl2 0 -ssl3 0 -tls1 0 -tls1.1 0 -tls1.2 1 \
|
|
|
|
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
|
test tls-bug58-1.0 {test protocol negotiation failure} {socket} {
# Following code is based on what was reported in bug #58. Prior
# to fix the program would crash with a segfault.
proc Accept {sock args} {
fconfigure $sock -blocking 0;
fileevent $sock readable [list Handshake $sock]
}
proc Handshake {sock} {
set ::done HAND
catch {tls::handshake $sock} msg
set ::done $msg
}
# NOTE: when doing an in-process client/server test, both sides need
# to be non-blocking for the TLS handshake
# Server - Only accept TLS 1.2
set s [tls::socket \
-certfile $serverCert -cafile $caCert -keyfile $serverKey \
-request 0 -require 0 -ssl2 0 -ssl3 0 -tls1 0 -tls1.1 0 -tls1.2 1 \
|