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.20 2003/12/15 18:46:20 razzell 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.21 2004/02/11 22:41:25 razzell 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
|
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
|
global commandSocket
if {[eof $commandSocket]} {
error "remote server disappeared"
}
if {[catch {puts $commandSocket $c} msg]} {
error "remote server disappaered: $msg"
}
if {[catch {puts $commandSocket "--Marker--Marker--Marker--"} msg]} {
error "remote server disappeared: $msg"
}
set resp ""
while {1} {
|
|
|
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
|
global commandSocket
if {[eof $commandSocket]} {
error "remote server disappeared"
}
if {[catch {puts $commandSocket $c} msg]} {
error "remote server disappeared: $msg"
}
if {[catch {puts $commandSocket "--Marker--Marker--Marker--"} msg]} {
error "remote server disappeared: $msg"
}
set resp ""
while {1} {
|
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
|
# We need to be able to send certificate values that normalize
# filenames across platforms
sendCommand {
set certsDir [file join [file dirname [info script]] 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]
}
}
}
test tlsIO-1.1 {arg parsing for socket command} {socket} {
list [catch {tls::socket -server} msg] $msg
} {1 {wrong # args: should be "tls::socket -server command ?options? port"}}
|
|
|
|
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
|
# We need to be able to send certificate values that normalize
# filenames across platforms
sendCommand {
set certsDir [file join [file dirname [info script]] 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 server.key]
set clientKey [file join $certsDir client.key]
}
}
}
test tlsIO-1.1 {arg parsing for socket command} {socket} {
list [catch {tls::socket -server} msg] $msg
} {1 {wrong # args: should be "tls::socket -server command ?options? port"}}
|