Check-in [2271d7b9c3]
Bounty program for improvements to Tcl and certain Tcl packages.
Overview
Comment:*** empty log message ***
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2271d7b9c3c441b28e7fb1e8a1686792a9eb963c
User & Date: awb on 2000-06-03 03:00:22
Other Links: manifest | tags
Context
2000-06-03
03:17
*** empty log message *** check-in: a05622355a user: awb tags: trunk
03:00
*** empty log message *** check-in: 2271d7b9c3 user: awb tags: trunk
02:30
*** empty log message *** check-in: 4bf039c9a5 user: awb tags: trunk
Changes

Modified tests/tlsIo.test from [8c7120ca15] to [ff25032914].

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.8 2000/06/03 02:30:03 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











|







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.9 2000/06/03 03:00:22 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
1680
1681
1682
1683
1684
1685
1686
1687


1688
1689
1690
1691
1692
1693
1694
    exec $::tcltest::tcltest script2 &
    after 5000 { set ok_to_proceed 1 }
    vwait ok_to_proceed

    # If we can still connect to the server, the socket got inherited.

    if {[catch {tls::socket 127.0.0.1 2828} msg]} {


	set x {server socket was not inherited}
    } else {
	close $msg
	set x {server socket was inherited}
    }

    removeFile script1






|
>
>







1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
    exec $::tcltest::tcltest script2 &
    after 5000 { set ok_to_proceed 1 }
    vwait ok_to_proceed

    # If we can still connect to the server, the socket got inherited.

    if {[catch {tls::socket \
	-certfile $clientCert -cafile $caCert -keyfile $clientKey \
   	 127.0.0.1 2828} msg]} {
	set x {server socket was not inherited}
    } else {
	close $msg
	set x {server socket was inherited}
    }

    removeFile script1
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735


1736
1737
1738
1739
1740
1741
1742
    # client socket, the socket will still be open.

    set f [open script2 w]
    puts $f [list set tcltest $::tcltest::tcltest]
    puts $f {
    	package require tls
    }
    puts $f "set f \[tls::socket -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 127.0.0.1 2829 \]"
    puts $f {
	exec $::tcltest::tcltest script1 &
	puts $f testing
	flush $f
	after 1000 exit
	vwait forever
    }
    close $f

    # Create the server socket

    set server [tls::socket -server accept 2829]


    proc accept { file host port } {

	# When the client connects, establish the read handler
	global server
	close $server
	fileevent $file readable [list getdata $file]
	fconfigure $file -buffering line -blocking 0






|











|
>
>







1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
    # client socket, the socket will still be open.

    set f [open script2 w]
    puts $f [list set tcltest $::tcltest::tcltest]
    puts $f {
    	package require tls
    }
    puts $f "set f \[tls::socket -certfile $clientCert -cafile $caCert -keyfile $clientKey 127.0.0.1 2829 \]"
    puts $f {
	exec $::tcltest::tcltest script1 &
	puts $f testing
	flush $f
	after 1000 exit
	vwait forever
    }
    close $f

    # Create the server socket

    set server [tls::socket \
	-certfile $serverCert -cafile $caCert -keyfile $serverKey \
	-server accept 2829]
    proc accept { file host port } {

	# When the client connects, establish the read handler
	global server
	close $server
	fileevent $file readable [list getdata $file]
	fconfigure $file -buffering line -blocking 0