Diff

Differences From Artifact [8c7120ca15]:

To Artifact [ff25032914]:


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.8 2000/06/03 02:30:03 awb Exp $
# 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
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 127.0.0.1 2828} msg]} {
    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
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 -server accept -certfile $serverCert -cafile $caCert -keyfile $serverKey 127.0.0.1 2829 \]"
    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 -server accept 2829]
    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