0000: 23 20 43 6f 6d 6d 61 6e 64 73 20 74 65 73 74 65 # Commands teste
0010: 64 20 69 6e 20 74 68 69 73 20 66 69 6c 65 3a 20 d in this file:
0020: 73 6f 63 6b 65 74 2e 0a 23 0a 23 20 54 68 69 73 socket..#.# This
0030: 20 66 69 6c 65 20 63 6f 6e 74 61 69 6e 73 20 61 file contains a
0040: 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 6f 66 20 74 collection of t
0050: 65 73 74 73 20 66 6f 72 20 6f 6e 65 20 6f 72 20 ests for one or
0060: 6d 6f 72 65 20 6f 66 20 74 68 65 20 54 63 6c 0a more of the Tcl.
0070: 23 20 62 75 69 6c 74 2d 69 6e 20 63 6f 6d 6d 61 # built-in comma
0080: 6e 64 73 2e 20 20 53 6f 75 72 63 69 6e 67 20 74 nds. Sourcing t
0090: 68 69 73 20 66 69 6c 65 20 69 6e 74 6f 20 54 63 his file into Tc
00a0: 6c 20 72 75 6e 73 20 74 68 65 20 74 65 73 74 73 l runs the tests
00b0: 20 61 6e 64 0a 23 20 67 65 6e 65 72 61 74 65 73 and.# generates
00c0: 20 6f 75 74 70 75 74 20 66 6f 72 20 65 72 72 6f output for erro
00d0: 72 73 2e 20 20 4e 6f 20 6f 75 74 70 75 74 20 6d rs. No output m
00e0: 65 61 6e 73 20 6e 6f 20 65 72 72 6f 72 73 20 77 eans no errors w
00f0: 65 72 65 20 66 6f 75 6e 64 2e 0a 23 0a 23 20 43 ere found..#.# C
0100: 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 39 opyright (c) 199
0110: 34 2d 31 39 39 36 20 53 75 6e 20 4d 69 63 72 6f 4-1996 Sun Micro
0120: 73 79 73 74 65 6d 73 2c 20 49 6e 63 2e 0a 23 20 systems, Inc..#
0130: 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 Copyright (c) 19
0140: 39 38 2d 32 30 30 30 20 41 6a 75 62 61 20 53 6f 98-2000 Ajuba So
0150: 6c 75 74 69 6f 6e 73 2e 20 0a 23 0a 23 20 53 65 lutions. .#.# Se
0160: 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 63 65 e the file "lice
0170: 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 20 69 nse.terms" for i
0180: 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73 nformation on us
0190: 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 72 69 age and redistri
01a0: 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 69 73 bution.# of this
01b0: 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20 61 file, and for a
01c0: 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20 41 DISCLAIMER OF A
01d0: 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0a 23 LL WARRANTIES..#
01e0: 0a 23 20 52 43 53 3a 20 40 28 23 29 20 24 49 64 .# RCS: @(#) $Id
01f0: 3a 20 74 6c 73 49 4f 2e 74 65 73 74 2c 76 20 31 : tlsIO.test,v 1
0200: 2e 31 34 2e 32 2e 32 20 32 30 30 30 2f 30 37 2f .14.2.2 2000/07/
0210: 31 32 20 30 31 3a 35 34 3a 30 33 20 68 6f 62 62 12 01:54:03 hobb
0220: 73 20 45 78 70 20 24 0a 0a 23 20 52 75 6e 6e 69 s Exp $..# Runni
0230: 6e 67 20 73 6f 63 6b 65 74 20 74 65 73 74 73 20 ng socket tests
0240: 77 69 74 68 20 61 20 72 65 6d 6f 74 65 20 73 65 with a remote se
0250: 72 76 65 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d 2d rver:.# --------
0260: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0270: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0280: 2d 2d 0a 23 20 0a 23 20 53 6f 6d 65 20 74 65 73 --.# .# Some tes
0290: 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 73 ts in socket.tes
02a0: 74 20 64 65 70 65 6e 64 20 6f 6e 20 74 68 65 20 t depend on the
02b0: 65 78 69 73 74 65 6e 63 65 20 6f 66 20 61 20 72 existence of a r
02c0: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 74 6f 0a emote server to.
02d0: 23 20 77 68 69 63 68 20 74 68 65 79 20 63 6f 6e # which they con
02e0: 6e 65 63 74 2e 20 54 68 65 20 72 65 6d 6f 74 65 nect. The remote
02f0: 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 server must be
0300: 61 6e 20 69 6e 73 74 61 6e 63 65 20 6f 66 20 74 an instance of t
0310: 63 6c 74 65 73 74 20 61 6e 64 20 69 74 0a 23 20 cltest and it.#
0320: 6d 75 73 74 20 72 75 6e 20 74 68 65 20 73 63 72 must run the scr
0330: 69 70 74 20 66 6f 75 6e 64 20 69 6e 20 74 68 65 ipt found in the
0340: 20 66 69 6c 65 20 22 72 65 6d 6f 74 65 2e 74 63 file "remote.tc
0350: 6c 22 20 69 6e 20 74 68 69 73 20 64 69 72 65 63 l" in this direc
0360: 74 6f 72 79 2e 20 59 6f 75 0a 23 20 63 61 6e 20 tory. You.# can
0370: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
0380: 20 73 65 72 76 65 72 20 6f 6e 20 61 6e 79 20 6d server on any m
0390: 61 63 68 69 6e 65 20 72 65 61 63 68 61 62 6c 65 achine reachable
03a0: 20 66 72 6f 6d 20 74 68 65 20 6d 61 63 68 69 6e from the machin
03b0: 65 20 6f 6e 0a 23 20 77 68 69 63 68 20 79 6f 75 e on.# which you
03c0: 20 77 61 6e 74 20 74 6f 20 72 75 6e 20 74 68 65 want to run the
03d0: 20 73 6f 63 6b 65 74 20 74 65 73 74 73 2c 20 62 socket tests, b
03e0: 79 20 69 73 73 75 69 6e 67 3a 0a 23 20 0a 23 20 y issuing:.# .#
03f0: 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f tcltest remo
0400: 74 65 2e 74 63 6c 20 2d 70 6f 72 74 20 38 30 34 te.tcl -port 804
0410: 38 09 23 20 4f 72 20 63 68 6f 6f 73 65 20 61 6e 8.# Or choose an
0420: 6f 74 68 65 72 20 70 6f 72 74 20 6e 75 6d 62 65 other port numbe
0430: 72 2e 0a 23 20 0a 23 20 49 66 20 74 68 65 20 6d r..# .# If the m
0440: 61 63 68 69 6e 65 20 79 6f 75 20 61 72 65 20 72 achine you are r
0450: 75 6e 6e 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 unning the remot
0460: 65 20 73 65 72 76 65 72 20 6f 6e 20 68 61 73 20 e server on has
0470: 73 65 76 65 72 61 6c 20 49 50 0a 23 20 69 6e 74 several IP.# int
0480: 65 72 66 61 63 65 73 2c 20 79 6f 75 20 63 61 6e erfaces, you can
0490: 20 63 68 6f 6f 73 65 20 77 68 69 63 68 20 69 6e choose which in
04a0: 74 65 72 66 61 63 65 20 74 68 65 20 73 65 72 76 terface the serv
04b0: 65 72 20 6c 69 73 74 65 6e 73 20 6f 6e 20 66 6f er listens on fo
04c0: 72 0a 23 20 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 r.# connections
04d0: 62 79 20 73 70 65 63 69 66 79 69 6e 67 20 74 68 by specifying th
04e0: 65 20 2d 61 64 64 72 65 73 73 20 63 6f 6d 6d 61 e -address comma
04f0: 6e 64 20 6c 69 6e 65 20 66 6c 61 67 2c 20 73 6f nd line flag, so
0500: 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 65 :.# .# tclte
0510: 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d 61 st remote.tcl -a
0520: 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 ddress your.mach
0530: 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 54 68 65 ine.com.# .# The
0540: 73 65 20 6f 70 74 69 6f 6e 73 20 63 61 6e 20 61 se options can a
0550: 6c 73 6f 20 62 65 20 73 65 74 20 62 79 20 65 6e lso be set by en
0560: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
0570: 6c 65 73 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 6f les. On Unix, yo
0580: 75 20 63 61 6e 0a 23 20 74 79 70 65 20 74 68 65 u can.# type the
0590: 73 65 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 se commands to t
05a0: 68 65 20 73 68 65 6c 6c 20 66 72 6f 6d 20 77 68 he shell from wh
05b0: 69 63 68 20 74 68 65 20 72 65 6d 6f 74 65 20 73 ich the remote s
05c0: 65 72 76 65 72 20 69 73 20 73 74 61 72 74 65 64 erver is started
05d0: 3a 0a 23 20 0a 23 20 20 20 20 20 73 68 65 6c 6c :.# .# shell
05e0: 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 50 % setenv serverP
05f0: 6f 72 74 20 38 30 34 38 0a 23 20 20 20 20 20 73 ort 8048.# s
0600: 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 73 65 72 hell% setenv ser
0610: 76 65 72 41 64 64 72 65 73 73 20 79 6f 75 72 2e verAddress your.
0620: 6d 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 machine.com.# .#
0630: 20 61 6e 64 20 73 75 62 73 65 71 75 65 6e 74 6c and subsequentl
0640: 79 20 79 6f 75 20 63 61 6e 20 73 74 61 72 74 20 y you can start
0650: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
0660: 72 20 77 69 74 68 3a 0a 23 20 0a 23 20 20 20 20 r with:.# .#
0670: 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e tcltest remote.
0680: 74 63 6c 0a 23 20 0a 23 20 74 6f 20 68 61 76 65 tcl.# .# to have
0690: 20 69 74 20 6c 69 73 74 65 6e 20 6f 6e 20 70 6f it listen on po
06a0: 72 74 20 38 30 34 38 20 6f 6e 20 74 68 65 20 69 rt 8048 on the i
06b0: 6e 74 65 72 66 61 63 65 20 79 6f 75 72 2e 6d 61 nterface your.ma
06c0: 63 68 69 6e 65 2e 63 6f 6d 2e 0a 23 20 20 20 20 chine.com..#
06d0: 20 0a 23 20 57 68 65 6e 20 74 68 65 20 73 65 72 .# When the ser
06e0: 76 65 72 20 73 74 61 72 74 73 2c 20 69 74 20 70 ver starts, it p
06f0: 72 69 6e 74 73 20 6f 75 74 20 61 20 64 65 74 61 rints out a deta
0700: 69 6c 65 64 20 6d 65 73 73 61 67 65 20 63 6f 6e iled message con
0710: 74 61 69 6e 69 6e 67 20 69 74 73 0a 23 20 63 6f taining its.# co
0720: 6e 66 69 67 75 72 61 74 69 6f 6e 20 69 6e 66 6f nfiguration info
0730: 72 6d 61 74 69 6f 6e 2c 20 61 6e 64 20 69 74 20 rmation, and it
0740: 77 69 6c 6c 20 62 6c 6f 63 6b 20 75 6e 74 69 6c will block until
0750: 20 6b 69 6c 6c 65 64 20 77 69 74 68 20 61 20 43 killed with a C
0760: 74 72 6c 2d 43 2e 0a 23 20 4f 6e 63 65 20 74 68 trl-C..# Once th
0770: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 e remote server
0780: 65 78 69 73 74 73 2c 20 79 6f 75 20 63 61 6e 20 exists, you can
0790: 72 75 6e 20 74 68 65 20 74 65 73 74 73 20 69 6e run the tests in
07a0: 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 77 69 74 socket.test wit
07b0: 68 0a 23 20 74 68 65 20 73 65 72 76 65 72 20 62 h.# the server b
07c0: 79 20 73 65 74 74 69 6e 67 20 74 77 6f 20 54 63 y setting two Tc
07d0: 6c 20 76 61 72 69 61 62 6c 65 73 3a 0a 23 20 0a l variables:.# .
07e0: 23 20 20 20 20 20 25 20 73 65 74 20 72 65 6d 6f # % set remo
07f0: 74 65 53 65 72 76 65 72 49 50 20 3c 6e 61 6d 65 teServerIP <name
0800: 20 6f 72 20 61 64 64 72 65 73 73 20 6f 66 20 6d or address of m
0810: 61 63 68 69 6e 65 20 6f 6e 20 77 68 69 63 68 20 achine on which
0820: 73 65 72 76 65 72 20 72 75 6e 73 3e 0a 23 20 20 server runs>.#
0830: 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 % set remoteS
0840: 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 erverPort 8048.#
0850: 20 0a 23 20 54 68 65 73 65 20 76 61 72 69 61 62 .# These variab
0860: 6c 65 73 20 61 72 65 20 61 6c 73 6f 20 73 65 74 les are also set
0870: 74 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 20 65 table from the e
0880: 6e 76 69 72 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 55 nvironment. On U
0890: 6e 69 78 2c 20 79 6f 75 20 63 61 6e 3a 0a 23 20 nix, you can:.#
08a0: 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 .# shell% se
08b0: 74 65 6e 76 20 72 65 6d 6f 74 65 53 65 72 76 65 tenv remoteServe
08c0: 72 49 50 20 6d 61 63 68 69 6e 65 2e 77 68 65 72 rIP machine.wher
08d0: 65 2e 73 65 72 76 65 72 2e 72 75 6e 73 0a 23 20 e.server.runs.#
08e0: 20 20 20 20 73 68 65 6c 6c 25 20 73 65 6e 65 74 shell% senet
08f0: 76 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f v remoteServerPo
0900: 72 74 20 38 30 34 38 0a 23 20 0a 23 20 54 68 65 rt 8048.# .# The
0910: 20 70 72 65 61 6d 62 6c 65 20 6f 66 20 74 68 65 preamble of the
0920: 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 69 6c socket.test fil
0930: 65 20 63 68 65 63 6b 73 20 74 6f 20 73 65 65 20 e checks to see
0940: 69 66 20 74 68 65 20 76 61 72 69 61 62 6c 65 73 if the variables
0950: 20 61 72 65 20 73 65 74 0a 23 20 65 69 74 68 65 are set.# eithe
0960: 72 20 69 6e 20 54 63 6c 20 6f 72 20 69 6e 20 74 r in Tcl or in t
0970: 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 3b 20 he environment;
0980: 69 66 20 74 68 65 79 20 61 72 65 2c 20 69 74 20 if they are, it
0990: 61 74 74 65 6d 70 74 73 20 74 6f 20 63 6f 6e 6e attempts to conn
09a0: 65 63 74 20 74 6f 0a 23 20 74 68 65 20 73 65 72 ect to.# the ser
09b0: 76 65 72 2e 20 49 66 20 74 68 65 20 63 6f 6e 6e ver. If the conn
09c0: 65 63 74 69 6f 6e 20 69 73 20 73 75 63 63 65 73 ection is succes
09d0: 73 66 75 6c 2c 20 74 68 65 20 74 65 73 74 73 20 sful, the tests
09e0: 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 using the remote
09f0: 0a 23 20 73 65 72 76 65 72 20 77 69 6c 6c 20 62 .# server will b
0a00: 65 20 70 65 72 66 6f 72 6d 65 64 3b 20 6f 74 68 e performed; oth
0a10: 65 72 77 69 73 65 2c 20 69 74 20 77 69 6c 6c 20 erwise, it will
0a20: 61 74 74 65 6d 70 74 20 74 6f 20 73 74 61 72 74 attempt to start
0a30: 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 the remote.# se
0a40: 72 76 65 72 20 28 76 69 61 20 65 78 65 63 29 20 rver (via exec)
0a50: 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 on platforms tha
0a60: 74 20 73 75 70 70 6f 72 74 20 74 68 69 73 2c 20 t support this,
0a70: 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f 73 on the local hos
0a80: 74 2c 0a 23 20 6c 69 73 74 65 6e 69 6e 67 20 61 t,.# listening a
0a90: 74 20 70 6f 72 74 20 38 30 34 38 2e 20 49 66 20 t port 8048. If
0aa0: 61 6c 6c 20 66 61 69 6c 73 2c 20 61 20 6d 65 73 all fails, a mes
0ab0: 73 61 67 65 20 69 73 20 70 72 69 6e 74 65 64 20 sage is printed
0ac0: 61 6e 64 20 74 68 65 20 74 65 73 74 73 0a 23 20 and the tests.#
0ad0: 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 using the remote
0ae0: 20 73 65 72 76 65 72 20 61 72 65 20 6e 6f 74 20 server are not
0af0: 70 65 72 66 6f 72 6d 65 64 2e 0a 0a 69 66 20 7b performed...if {
0b00: 5b 6c 73 65 61 72 63 68 20 5b 6e 61 6d 65 73 70 [lsearch [namesp
0b10: 61 63 65 20 63 68 69 6c 64 72 65 6e 5d 20 3a 3a ace children] ::
0b20: 74 63 6c 74 65 73 74 5d 20 3d 3d 20 2d 31 7d 20 tcltest] == -1}
0b30: 7b 0a 20 20 20 20 70 61 63 6b 61 67 65 20 72 65 {. package re
0b40: 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a 20 20 quire tcltest.
0b50: 20 20 6e 61 6d 65 73 70 61 63 65 20 69 6d 70 6f namespace impo
0b60: 72 74 20 2d 66 6f 72 63 65 20 3a 3a 74 63 6c 74 rt -force ::tclt
0b70: 65 73 74 3a 3a 2a 0a 7d 0a 0a 23 20 4c 6f 61 64 est::*.}..# Load
0b80: 20 74 68 65 20 74 6c 73 20 70 61 63 6b 61 67 65 the tls package
0b90: 0a 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
0ba0: 65 20 74 6c 73 0a 0a 73 65 74 20 74 6c 73 53 65 e tls..set tlsSe
0bb0: 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 0a 73 rverPort 8048..s
0bc0: 65 74 20 63 65 72 74 73 44 69 72 20 5b 66 69 6c et certsDir [fil
0bd0: 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 e join [file dir
0be0: 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70 name [info scrip
0bf0: 74 5d 5d 20 63 65 72 74 73 5d 20 0a 0a 73 65 74 t]] certs] ..set
0c00: 20 73 65 72 76 65 72 43 65 72 74 20 5b 66 69 6c serverCert [fil
0c10: 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 e join $certsDir
0c20: 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a 73 65 74 server.pem].set
0c30: 20 63 6c 69 65 6e 74 43 65 72 74 20 5b 66 69 6c clientCert [fil
0c40: 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 e join $certsDir
0c50: 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 65 74 client.pem].set
0c60: 20 63 61 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f caCert [file jo
0c70: 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 63 in $certsDir cac
0c80: 65 72 74 2e 70 65 6d 5d 0a 73 65 74 20 73 65 72 ert.pem].set ser
0c90: 76 65 72 4b 65 79 20 5b 66 69 6c 65 20 6a 6f 69 verKey [file joi
0ca0: 6e 20 24 63 65 72 74 73 44 69 72 20 73 6b 65 79 n $certsDir skey
0cb0: 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e 74 .pem].set client
0cc0: 4b 65 79 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 Key [file join $
0cd0: 63 65 72 74 73 44 69 72 20 63 6b 65 79 2e 70 65 certsDir ckey.pe
0ce0: 6d 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 m]..# Some tests
0cf0: 20 72 65 71 75 69 72 65 20 74 68 65 20 74 65 73 require the tes
0d00: 74 74 68 72 65 61 64 20 63 6f 6d 6d 61 6e 64 0a tthread command.
0d10: 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a .set ::tcltest::
0d20: 74 65 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 testConstraints(
0d30: 74 65 73 74 74 68 72 65 61 64 29 20 5c 0a 09 5b testthread) \..[
0d40: 65 78 70 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d expr {[info comm
0d50: 61 6e 64 73 20 74 65 73 74 74 68 72 65 61 64 5d ands testthread]
0d60: 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 49 66 != {}}]..#.# If
0d70: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
0d80: 6f 72 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 or remoteServerP
0d90: 6f 72 74 20 61 72 65 20 6e 6f 74 20 73 65 74 2c ort are not set,
0da0: 20 63 68 65 63 6b 20 69 6e 20 74 68 65 0a 23 20 check in the.#
0db0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 environment vari
0dc0: 61 62 6c 65 73 20 66 6f 72 20 65 78 74 65 72 6e ables for extern
0dd0: 61 6c 6c 79 20 73 65 74 20 76 61 6c 75 65 73 2e ally set values.
0de0: 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 .#..if {![info e
0df0: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
0e00: 65 72 49 50 5d 7d 20 7b 0a 20 20 20 20 69 66 20 erIP]} {. if
0e10: 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e {[info exists en
0e20: 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 v(remoteServerIP
0e30: 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 )]} {..set remot
0e40: 65 53 65 72 76 65 72 49 50 20 24 65 6e 76 28 72 eServerIP $env(r
0e50: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 0a 20 emoteServerIP).
0e60: 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 }.}.if {![inf
0e70: 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 o exists remoteS
0e80: 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 erverPort]} {.
0e90: 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 if {[info exis
0ea0: 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 ts env(remoteSer
0eb0: 76 65 72 50 6f 72 74 29 5d 7d 20 7b 0a 09 73 65 verPort)]} {..se
0ec0: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
0ed0: 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 rt $env(remoteSe
0ee0: 72 76 65 72 50 6f 72 74 29 0a 20 20 20 20 7d 20 rverPort). }
0ef0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 69 else {. i
0f00: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0f10: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 7d remoteServerIP]}
0f20: 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f {.. set remo
0f30: 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 74 6c teServerPort $tl
0f40: 73 53 65 72 76 65 72 50 6f 72 74 0a 20 20 20 20 sServerPort.
0f50: 20 20 20 20 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 }. }.}..#
0f60: 0a 23 20 43 68 65 63 6b 20 69 66 20 77 65 27 72 .# Check if we'r
0f70: 65 20 73 75 70 70 6f 73 65 64 20 74 6f 20 64 6f e supposed to do
0f80: 20 74 65 73 74 73 20 61 67 61 69 6e 73 74 20 74 tests against t
0f90: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
0fa0: 0a 23 0a 0a 73 65 74 20 64 6f 54 65 73 74 73 57 .#..set doTestsW
0fb0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
0fc0: 31 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 1.if {![info exi
0fd0: 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 sts remoteServer
0fe0: 49 50 5d 20 26 26 20 28 24 74 63 6c 5f 70 6c 61 IP] && ($tcl_pla
0ff0: 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 tform(platform)
1000: 21 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 29 7d != "macintosh")}
1010: 20 7b 0a 20 20 20 20 73 65 74 20 72 65 6d 6f 74 {. set remot
1020: 65 53 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e eServerIP 127.0.
1030: 30 2e 31 0a 7d 0a 69 66 20 7b 28 24 64 6f 54 65 0.1.}.if {($doTe
1040: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1050: 76 65 72 20 3d 3d 20 31 29 20 26 26 20 28 21 5b ver == 1) && (![
1060: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
1070: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 29 7d 20 teServerPort])}
1080: 7b 0a 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 {. set remote
1090: 53 65 72 76 65 72 50 6f 72 74 20 24 74 6c 73 53 ServerPort $tlsS
10a0: 65 72 76 65 72 50 6f 72 74 0a 7d 0a 0a 23 20 41 erverPort.}..# A
10b0: 74 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 ttempt to connec
10c0: 74 20 74 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 t to a remote se
10d0: 72 76 65 72 20 69 66 20 6f 6e 65 20 69 73 20 61 rver if one is a
10e0: 6c 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 lready running.
10f0: 49 66 20 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 If it.# is not r
1100: 75 6e 6e 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f unning or for so
1110: 6d 65 20 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 me other reason
1120: 74 68 65 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c the connect fail
1130: 73 2c 20 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 s, attempt to.#
1140: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
1150: 20 73 65 72 76 65 72 20 6f 6e 20 74 68 65 20 6c server on the l
1160: 6f 63 61 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e ocal host listen
1170: 69 6e 67 20 6f 6e 20 70 6f 72 74 20 38 30 34 38 ing on port 8048
1180: 2e 20 54 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 . This.# is only
1190: 20 64 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 done on platfor
11a0: 6d 73 20 74 68 61 74 20 73 75 70 70 6f 72 74 20 ms that support
11b0: 65 78 65 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f exec (i.e. not o
11c0: 6e 20 74 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 n the Mac). On.#
11d0: 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 platforms that
11e0: 64 6f 20 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 do not support e
11f0: 78 65 63 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 xec, the remote
1200: 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 73 server must be s
1210: 74 61 72 74 65 64 0a 23 20 62 79 20 74 68 65 20 tarted.# by the
1220: 75 73 65 72 20 62 65 66 6f 72 65 20 72 75 6e 6e user before runn
1230: 69 6e 67 20 74 68 65 20 74 65 73 74 73 2e 0a 0a ing the tests...
1240: 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 set remoteProcCh
1250: 61 6e 20 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e an "".set comman
1260: 64 53 6f 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 dSocket "".if {$
1270: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1280: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 eServer} {. c
1290: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d atch {close $com
12a0: 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 mandSocket}.
12b0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 if {[catch {set
12c0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 commandSocket [t
12d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
12e0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
12f0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
1300: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
1310: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
1320: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
1330: 49 50 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 IP \.. $remot
1340: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d 20 21 eServerPort]}] !
1350: 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 = 0} {..if {[inf
1360: 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d o commands exec]
1370: 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 73 == ""} {.. s
1380: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1390: 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 78 65 eason "can't exe
13a0: 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f 54 65 c".. set doTe
13b0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
13c0: 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a ver 0..} else {.
13d0: 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 . set remoteS
13e0: 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e erverIP 127.0.0.
13f0: 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 1.. set remot
1400: 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e eFile [file join
1410: 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e 74 63 [pwd] remote.tc
1420: 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 74 l].. if {[cat
1430: 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 50 72 ch {set remotePr
1440: 6f 63 43 68 61 6e 20 5c 0a 09 09 09 09 5b 6f 70 ocChan \.....[op
1450: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
1460: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 24 ltest::tcltest $
1470: 72 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 09 09 remoteFile \....
1480: 09 09 2d 73 65 72 76 65 72 49 73 53 69 6c 65 6e ..-serverIsSilen
1490: 74 20 5c 0a 09 09 09 09 09 2d 70 6f 72 74 20 24 t \......-port $
14a0: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
14b0: 20 5c 0a 09 09 09 09 09 2d 61 64 64 72 65 73 73 \......-address
14c0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
14d0: 5d 22 20 5c 0a 09 09 09 09 09 77 2b 5d 7d 20 5c ]" \......w+]} \
14e0: 0a 09 09 20 20 20 6d 73 67 5d 20 3d 3d 20 30 7d ... msg] == 0}
14f0: 20 7b 0a 09 09 61 66 74 65 72 20 31 30 30 30 0a {...after 1000.
1500: 09 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 ..if {[catch {se
1510: 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 t commandSocket
1520: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
1530: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
1540: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
1550: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
1560: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
1570: 0a 09 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 .....$remoteServ
1580: 65 72 49 50 20 5c 0a 09 09 09 09 24 72 65 6d 6f erIP \.....$remo
1590: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d teServerPort]} m
15a0: 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 sg] == 0} {...
15b0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f fconfigure $co
15c0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 mmandSocket -tra
15d0: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 nslation crlf -b
15e0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 uffering line...
15f0: 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 } else {... s
1600: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1610: 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 eason $msg...
1620: 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 set doTestsWith
1630: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 RemoteServer 0..
1640: 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b .}.. } else {
1650: 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 ...set noRemoteT
1660: 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 estReason "$msg
1670: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
1680: 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54 65 73 est"...set doTes
1690: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
16a0: 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 er 0.. }..}.
16b0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f } else {..fco
16c0: 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 nfigure $command
16d0: 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 Socket -translat
16e0: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
16f0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d ing line. }.}
1700: 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 61 ..# Some tests a
1710: 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 re run only if w
1720: 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65 73 74 e are doing test
1730: 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20 72 65 ing against a re
1740: 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 65 74 mote server..set
1750: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 ::tcltest::test
1760: 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 65 Constraints(doTe
1770: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1780: 76 65 72 29 20 24 64 6f 54 65 73 74 73 57 69 74 ver) $doTestsWit
1790: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 hRemoteServer.if
17a0: 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 {$doTestsWithRe
17b0: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 30 7d moteServer == 0}
17c0: 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 {. if {[stri
17d0: 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a 74 63 ng first s $::tc
17e0: 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 ltest::verbose]
17f0: 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 != -1} {. .pu
1800: 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74 65 73 ts "Skipping tes
1810: 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65 20 73 ts with remote s
1820: 65 72 76 65 72 2e 20 53 65 65 20 74 65 73 74 73 erver. See tests
1830: 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 /socket.test for
1840: 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 "..puts "informa
1850: 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 tion on how to r
1860: 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 un remote server
1870: 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73 6f 6e ."..puts "Reason
1880: 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 for not doing r
1890: 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 6e 6f emote tests: $no
18a0: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
18b0: 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 ". }.}..#.# I
18c0: 66 20 77 65 20 64 6f 20 74 68 65 20 74 65 73 74 f we do the test
18d0: 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d s, define a comm
18e0: 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 63 6f and to send a co
18f0: 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 mmand to the.# r
1900: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 0a emote server..#.
1910: 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 .if {$doTestsWit
1920: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d hRemoteServer ==
1930: 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 1} {. proc s
1940: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b endCommand {c} {
1950: 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 ..global command
1960: 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f Socket...if {[eo
1970: 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 f $commandSocket
1980: 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 ]} {.. error
1990: 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 "remote server d
19a0: 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a isappeared"..}..
19b0: 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 .if {[catch {put
19c0: 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 s $commandSocket
19d0: 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 $c} msg]} {..
19e0: 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 error "remote
19f0: 73 65 72 76 65 72 20 64 69 73 61 70 70 61 65 72 server disappaer
1a00: 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 ed: $msg"..}..if
1a10: 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 {[catch {puts $
1a20: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d commandSocket "-
1a30: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1a40: 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d -Marker--"} msg]
1a50: 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 } {.. error "
1a60: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 remote server di
1a70: 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 sappeared: $msg"
1a80: 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 22 ..}...set resp "
1a90: 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 "..while {1} {..
1aa0: 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 set line [ge
1ab0: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
1ac0: 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 t].. if {[eof
1ad0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
1ae0: 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 6d } {...error "rem
1af0: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
1b00: 70 65 61 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 peared".. }..
1b10: 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 if {[string
1b20: 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 2d compare $line "-
1b30: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1b40: 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 -Marker--"] == 0
1b50: 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e } {...if {[strin
1b60: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
1b70: 78 20 24 72 65 73 70 20 30 5d 20 65 72 72 6f 72 x $resp 0] error
1b80: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 ] == 0} {...
1b90: 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 error [lindex $r
1ba0: 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 esp 1]...} else
1bb0: 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b {... return [
1bc0: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a lindex $resp 1].
1bd0: 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ..}.. } else
1be0: 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 {...append resp
1bf0: 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 $line "\n"..
1c00: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 }..}. }.}..te
1c10: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 st tlsIO-1.1 {ar
1c20: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1c30: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1c40: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1c50: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1c60: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d ocket -server} m
1c70: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
1c80: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
1c90: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
1ca0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
1cb0: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
1cc0: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
1cd0: 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 O-1.2 {arg parsi
1ce0: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1cf0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1d00: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1d10: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1d20: 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d server foo} msg]
1d30: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
1d40: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
1d50: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
1d60: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
1d70: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
1d80: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
1d90: 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .3 {arg parsing
1da0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1db0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1dc0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1dd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
1de0: 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d ddr} msg] $msg.}
1df0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
1e00: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
1e10: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
1e20: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
1e30: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 34 ..test tlsIO-1.4
1e40: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
1e50: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
1e60: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
1e70: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
1e80: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 s::socket -myadd
1e90: 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 r 127.0.0.1} msg
1ea0: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
1eb0: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
1ec0: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
1ed0: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
1ee0: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
1ef0: 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 20 70 61 lsIO-1.5 {arg pa
1f00: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
1f10: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
1f20: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
1f30: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
1f40: 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 t -myport} msg]
1f50: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
1f60: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
1f70: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
1f80: 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 ?options? host p
1f90: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
1fa0: 49 4f 2d 31 2e 36 20 7b 61 72 67 20 70 61 72 73 IO-1.6 {arg pars
1fb0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
1fc0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
1fd0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
1fe0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
1ff0: 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 6d 73 -myport xxxx} ms
2000: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2010: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2020: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2030: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2040: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
2050: 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 72 67 20 70 tlsIO-1.7 {arg p
2060: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2070: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2080: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
2090: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
20a0: 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 32 7d et -myport 2522}
20b0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
20c0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
20d0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
20e0: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
20f0: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
2100: 73 74 20 74 6c 73 49 4f 2d 31 2e 38 20 7b 61 72 st tlsIO-1.8 {ar
2110: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2120: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2130: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2140: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2150: 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a 7d 20 6d ocket -froboz} m
2160: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2170: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2180: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2190: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
21a0: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
21b0: 20 74 6c 73 49 4f 2d 31 2e 39 20 7b 61 72 67 20 tlsIO-1.9 {arg
21c0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
21d0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
21e0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
21f0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2200: 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 20 ket -server foo
2210: 2d 6d 79 70 6f 72 74 20 32 35 32 31 20 33 33 33 -myport 2521 333
2220: 33 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 3} msg] $msg.} {
2230: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2240: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2250: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2260: 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 command ?options
2270: 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 ? port"}}..test
2280: 74 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67 20 tlsIO-1.10 {arg
2290: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
22a0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
22b0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
22c0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
22d0: 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d 6a ket host 2528 -j
22e0: 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d unk} msg] $msg.}
22f0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2300: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2310: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
2320: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
2330: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 ..test tlsIO-1.1
2340: 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 1 {arg parsing f
2350: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2360: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2370: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2380: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2390: 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 30 er callback 2520
23a0: 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d --} msg] $msg.}
23b0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
23c0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
23d0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
23e0: 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f r command ?optio
23f0: 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ns? port"}}..tes
2400: 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 72 t tlsIO-1.12 {ar
2410: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2420: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2430: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2440: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2450: 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f 72 ocket foo badpor
2460: 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b t} msg] $msg.} {
2470: 31 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74 65 1 {expected inte
2480: 67 65 72 20 62 75 74 20 67 6f 74 20 22 62 61 64 ger but got "bad
2490: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
24a0: 73 49 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e sIO-2.1 {tcp con
24b0: 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 nection} {socket
24c0: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
24d0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
24e0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
24f0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
2500: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
2510: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
2520: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
2530: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 74 er 2000 "set x t
2540: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 7d imed_out"]. }
2550: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
2560: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
2570: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
2580: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
2590: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
25a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
25b0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 $serverKey 8828
25c0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
25d0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
25e0: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
25f0: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a {.. global x.
2600: 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a . set x done.
2610: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
2620: 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 e $file..}..puts
2630: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
2640: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
2650: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 imer..close $f..
2660: 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 puts $x. }.
2670: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2680: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
2690: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
26a0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
26b0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
26c0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
26d0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 {tls::socket -ce
26e0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
26f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2700: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
2710: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
2720: 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 0.1 8828} msg]}
2730: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
2740: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
2750: 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e {. lappen
2760: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
2770: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 close $msg
2780: 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 . }. lappe
2790: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
27a0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
27b0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
27c0: 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 one {}}..if [inf
27d0: 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 20 7b o exists port] {
27e0: 0a 20 20 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d . incr port.}
27f0: 20 65 6c 73 65 20 7b 20 0a 20 20 20 20 73 65 74 else { . set
2800: 20 70 6f 72 74 20 5b 65 78 70 72 20 24 74 6c 73 port [expr $tls
2810: 53 65 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 ServerPort + [pi
2820: 64 5d 25 31 30 32 34 5d 0a 7d 0a 0a 74 65 73 74 d]%1024].}..test
2830: 20 74 6c 73 49 4f 2d 32 2e 32 20 7b 74 63 70 20 tlsIO-2.2 {tcp
2840: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
2850: 63 6c 69 65 6e 74 20 70 6f 72 74 20 73 70 65 63 client port spec
2860: 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 ified} {socket s
2870: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
2880: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
2890: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
28a0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
28b0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
28c0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
28d0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
28e0: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
28f0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
2900: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
2910: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
2920: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
2930: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
2940: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
2950: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
2960: 38 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 74 8829 \]". put
2970: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
2980: 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 ept {sock addr p
2990: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
29a0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
29b0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
29c0: 65 74 73 20 24 73 6f 63 6b 5d 20 24 70 6f 72 74 ets $sock] $port
29d0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
29e0: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ose $sock.
29f0: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
2a00: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
2a10: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
2a20: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
2a30: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
2a40: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2a50: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
2a60: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
2a70: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
2a80: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
2a90: 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 74 . global port
2aa0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
2ab0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
2ac0: 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a 09 2d 63 port $port \..-c
2ad0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
2ae0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
2af0: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
2b00: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
2b10: 2e 30 2e 31 20 38 38 32 39 7d 20 73 6f 63 6b 5d .0.1 8829} sock]
2b20: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
2b30: 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 7b x $sock..catch {
2b40: 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b close [tls::sock
2b50: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 et 127.0.0.1 882
2b60: 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 9]}. } else {
2b70: 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 . puts $s
2b80: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 ock hello..flush
2b90: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c $sock. l
2ba0: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
2bb0: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
2bc0: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
2bd0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2be0: 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 61 64 t x.} [list read
2bf0: 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 22 5d y "hello $port"]
2c00: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 33 ..test tlsIO-2.3
2c10: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
2c20: 20 77 69 74 68 20 63 6c 69 65 6e 74 20 69 6e 74 with client int
2c30: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
2c40: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
2c50: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
2c60: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
2c70: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
2c80: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
2c90: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
2ca0: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
2cb0: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
2cc0: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
2cd0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
2ce0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
2cf0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
2d00: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
2d10: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
2d20: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
2d30: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 30 20 $serverKey 8830
2d40: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
2d50: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
2d60: 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 sock addr port}
2d70: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
2d80: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
2d90: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
2da0: 73 6f 63 6b 5d 20 24 61 64 64 72 22 0a 20 20 20 sock] $addr".
2db0: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
2dc0: 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 sock.
2dd0: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
2de0: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
2df0: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
2e00: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
2e10: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
2e20: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
2e30: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
2e40: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
2e50: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
2e60: 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 gets $f x.
2e70: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
2e80: 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 :socket -myaddr
2e90: 31 32 37 2e 30 2e 30 2e 31 20 5c 0a 09 2d 63 65 127.0.0.1 \..-ce
2ea0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
2eb0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2ec0: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
2ed0: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
2ee0: 30 2e 31 20 38 38 33 30 7d 20 73 6f 63 6b 5d 7d 0.1 8830} sock]}
2ef0: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
2f00: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 $sock. } els
2f10: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
2f20: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 $sock hello..ca
2f30: 74 63 68 20 7b 66 6c 75 73 68 20 24 73 6f 63 6b tch {flush $sock
2f40: 7d 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e }. lappen
2f50: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
2f60: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 close $soc
2f70: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 k. }. clos
2f80: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
2f90: 20 7b 72 65 61 64 79 20 7b 68 65 6c 6c 6f 20 31 {ready {hello 1
2fa0: 32 37 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 27.0.0.1}}..test
2fb0: 20 74 6c 73 49 4f 2d 32 2e 34 20 7b 74 63 70 20 tlsIO-2.4 {tcp
2fc0: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
2fd0: 73 65 72 76 65 72 20 69 6e 74 65 72 66 61 63 65 server interface
2fe0: 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 specified} {soc
2ff0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3000: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
3010: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
3020: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
3030: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
3040: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
3050: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
3060: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f r 2000 "set x do
3070: 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ne"]. }. p
3080: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3090: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
30a0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
30b0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
30c0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
30d0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
30e0: 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 5b 69 6e rKey -myaddr [in
30f0: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 fo hostname] 883
3100: 31 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 1 \]". puts $
3110: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
3120: 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 {sock addr port
3130: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
3140: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
3150: 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 puts "[gets
3160: 20 24 73 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 $sock]".
3170: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
3180: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
3190: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
31a0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
31b0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
31c0: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
31d0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
31e0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
31f0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3200: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3210: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
3220: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
3230: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
3240: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
3250: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3260: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
3270: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
3280: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
3290: 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 8831} sock]} {.
32a0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 set x $s
32b0: 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ock. } else {
32c0: 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 . puts $s
32d0: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 ock hello..flush
32e0: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c $sock. l
32f0: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
3300: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
3310: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
3320: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
3330: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c t x.} {ready hel
3340: 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d lo}..test tlsIO-
3350: 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.5 {tcp connect
3360: 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e 64 61 ion with redunda
3370: 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 7d 20 nt server port}
3380: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
3390: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
33a0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
33b0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
33c0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
33d0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
33e0: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
33f0: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
3400: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 x done"]. }.
3410: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
3420: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
3430: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
3440: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
3450: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3460: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
3470: 65 72 76 65 72 4b 65 79 20 38 38 33 32 20 5c 5d erverKey 8832 \]
3480: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
3490: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f .proc accept {so
34a0: 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a ck addr port} {.
34b0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
34c0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
34d0: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f puts "[gets $so
34e0: 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 ck]".
34f0: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3500: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
3510: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
3520: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3530: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3540: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
3550: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3560: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3570: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3580: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3590: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
35a0: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
35b0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
35c0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
35d0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
35e0: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
35f0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
3600: 2e 30 2e 30 2e 31 20 38 38 33 32 7d 20 73 6f 63 .0.0.1 8832} soc
3610: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 k]} {. se
3620: 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 t x $sock. }
3630: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 else {. p
3640: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a uts $sock hello.
3650: 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 .flush $sock.
3660: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b lappend x [
3670: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 gets $f].
3680: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3690: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
36a0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
36b0: 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 dy hello}.test t
36c0: 6c 73 49 4f 2d 32 2e 36 20 7b 74 63 70 20 63 6f lsIO-2.6 {tcp co
36d0: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
36e0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 t} {. set sta
36f0: 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 tus ok. if {!
3700: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 6f 63 6b [catch {set sock
3710: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
3720: 37 2e 30 2e 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 7.0.0.1 8833]}]}
3730: 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 {..if {![catch
3740: 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b {gets $sock}]} {
3750: 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 75 73 .. set status
3760: 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 broken..}..clos
3770: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
3780: 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f set status.} o
3790: 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e k..test tlsIO-2.
37a0: 37 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 7 {echo server,
37b0: 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 one line} {socke
37c0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
37d0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
37e0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
37f0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
3800: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
3810: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
3820: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
3830: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
3840: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
3850: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
3860: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
3870: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
3880: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
3890: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
38a0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
38b0: 65 79 20 38 38 33 34 20 5c 5d 22 0a 20 20 20 20 ey 8834 \]".
38c0: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
38d0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
38e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
38f0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
3900: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
3910: 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ].. fconfigur
3920: 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $s -translatio
3930: 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 n lf -buffering
3940: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
3950: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
3960: 09 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 . set l [get
3970: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 s $s].
3980: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
3990: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
39a0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
39b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c cl
39c0: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
39d0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
39e0: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ne.
39f0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
3a00: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
3a10: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
3a20: 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 }..}..puts rea
3a30: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3a40: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3a50: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
3a60: 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 done. }.
3a70: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3a80: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
3a90: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
3aa0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
3ab0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
3ac0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
3ad0: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
3ae0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3af0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
3b00: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
3b10: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 34 5d 127.0.0.1 8834]
3b20: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
3b30: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
3b40: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
3b50: 6c 66 0a 20 20 20 20 70 75 74 73 20 24 73 20 22 lf. puts $s "
3b60: 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a hello abcdefghij
3b70: 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 66 74 65 klmnop". afte
3b80: 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 78 r 1000. set x
3b90: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
3ba0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
3bb0: 79 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 y [gets $f].
3bc0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 6c 69 73 close $f. lis
3bd0: 74 20 24 78 20 24 79 0a 7d 20 7b 7b 68 65 6c 6c t $x $y.} {{hell
3be0: 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e o abcdefghijklmn
3bf0: 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 op} done}..test
3c00: 74 6c 73 49 4f 2d 32 2e 38 20 7b 65 63 68 6f 20 tlsIO-2.8 {echo
3c10: 73 65 72 76 65 72 2c 20 6c 6f 6f 70 20 35 30 20 server, loop 50
3c20: 74 69 6d 65 73 2c 20 73 69 6e 67 6c 65 20 63 6f times, single co
3c30: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
3c40: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 t stdio} {. s
3c50: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
3c60: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
3c70: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
3c80: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
3c90: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3ca0: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3cb0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3cc0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
3cd0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
3ce0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
3cf0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 $serverKey 8835
3d00: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
3d10: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
3d20: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 {s a p} {.
3d30: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
3d40: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
3d50: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 t echo $s].
3d60: 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 fconfigur
3d70: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
3d80: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
3d90: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
3da0: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 . global i.
3db0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
3dc0: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
3dd0: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
3de0: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
3df0: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
3e00: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
3e10: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
3e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
3e30: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
3e40: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a } else { .
3e50: 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 . incr i
3e60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3e70: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
3e80: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
3e90: 73 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 65 set i 0..puts re
3ea0: 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b ady..set timer [
3eb0: 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 after 20000 "set
3ec0: 20 78 20 64 6f 6e 65 22 5d 0a 09 76 77 61 69 74 x done"]..vwait
3ed0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3ee0: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3ef0: 66 0a 09 70 75 74 73 20 22 64 6f 6e 65 20 24 69 f..puts "done $i
3f00: 22 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 ". }. clos
3f10: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3f20: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3f30: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3f40: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3f50: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
3f60: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
3f70: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
3f80: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
3f90: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
3fa0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
3fb0: 2e 30 2e 30 2e 31 20 38 38 33 35 5d 0a 20 20 20 .0.0.1 8835].
3fc0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
3fd0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
3fe0: 20 20 20 63 61 74 63 68 20 7b 0a 09 66 6f 72 20 catch {..for
3ff0: 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 20 3c 20 {set x 0} {$x <
4000: 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 50} {incr x} {..
4010: 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 6c puts $s "hel
4020: 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d lo abcdefghijklm
4030: 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 73 20 24 nop".. gets $
4040: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 s..}. }. c
4050: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 61 74 63 lose $s. catc
4060: 68 20 7b 73 65 74 20 78 20 5b 67 65 74 73 20 24 h {set x [gets $
4070: 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 f]}. close $f
4080: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 64 6f . set x.} {do
4090: 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 ne 50}..test tls
40a0: 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20 63 IO-2.9 {socket c
40b0: 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 onflict} {socket
40c0: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 stdio} {. se
40d0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
40e0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
40f0: 38 38 32 38 5d 0a 20 20 20 20 72 65 6d 6f 76 65 8828]. remove
4100: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
4110: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
4120: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 2d pt w]. puts -
4130: 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 7b 70 61 nonewline $f {pa
4140: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
4150: 73 3b 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s; tls::socket -
4160: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
4170: 32 38 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 28}. close $f
4180: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4190: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
41a0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
41b0: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
41c0: 73 20 24 66 0a 20 20 20 20 61 66 74 65 72 20 31 s $f. after 1
41d0: 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 00. set x [li
41e0: 73 74 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 st [catch {close
41f0: 20 24 66 7d 20 6d 73 67 5d 20 24 6d 73 67 5d 0a $f} msg] $msg].
4200: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
4210: 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 set x.} {1 {cou
4220: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
4230: 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 t: address alrea
4240: 64 79 20 69 6e 20 75 73 65 0a 20 20 20 20 77 68 dy in use. wh
4250: 69 6c 65 20 65 78 65 63 75 74 69 6e 67 0a 22 3a ile executing.":
4260: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4270: 7b 74 6c 73 3a 3a 5f 61 63 63 65 70 74 20 7b 2d {tls::_accept {-
4280: 73 65 72 76 65 72 20 31 7d 20 61 63 63 65 70 74 server 1} accept
4290: 7d 20 38 38 32 38 22 0a 20 20 20 20 28 22 65 76 } 8828". ("ev
42a0: 61 6c 22 20 62 6f 64 79 20 6c 69 6e 65 20 31 29 al" body line 1)
42b0: 0a 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f . invoked fro
42c0: 6d 20 77 69 74 68 69 6e 0a 22 65 76 61 6c 20 3a m within."eval :
42d0: 3a 73 6f 63 6b 65 74 20 24 73 6f 70 74 73 22 0a :socket $sopts".
42e0: 20 20 20 20 28 70 72 6f 63 65 64 75 72 65 20 22 (procedure "
42f0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 22 20 6c 69 6e tls::socket" lin
4300: 65 20 36 32 29 0a 20 20 20 20 69 6e 76 6f 6b 65 e 62). invoke
4310: 64 20 66 72 6f 6d 20 77 69 74 68 69 6e 0a 22 74 d from within."t
4320: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4330: 65 72 20 61 63 63 65 70 74 20 38 38 32 38 22 0a er accept 8828".
4340: 20 20 20 20 28 66 69 6c 65 20 22 73 63 72 69 70 (file "scrip
4350: 74 22 20 6c 69 6e 65 20 31 29 7d 7d 0a 0a 74 65 t" line 1)}}..te
4360: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 st tlsIO-2.10 {c
4370: 6c 6f 73 65 20 6f 6e 20 61 63 63 65 70 74 2c 20 lose on accept,
4380: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 accepted socket
4390: 6c 69 76 65 73 7d 20 7b 73 6f 63 6b 65 74 20 6b lives} {socket k
43a0: 6e 6f 77 6e 42 75 67 7d 20 7b 0a 20 20 20 20 73 nownBug} {. s
43b0: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 et done 0. se
43c0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
43d0: 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 0000 "set done t
43e0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
43f0: 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b et ss [tls::sock
4400: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4410: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
4420: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
4430: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
4440: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
4450: 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 830]. proc ac
4460: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
4470: 67 6c 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 global ss..close
4480: 20 24 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 $ss..fileevent
4490: 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $s readable "rea
44a0: 64 69 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 dit $s"..fconfig
44b0: 75 72 65 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 ure $s -trans lf
44c0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
44d0: 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c readit {s} {..gl
44e0: 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 obal done..gets
44f0: 24 73 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 $s..close $s..se
4500: 74 20 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 t done 1. }.
4510: 20 20 20 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a set cs [tls::
4520: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
4530: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
4540: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
4550: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
4560: 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 Key [info hostna
4570: 6d 65 5d 20 38 38 33 30 5d 0a 20 20 20 20 63 6c me] 8830]. cl
4580: 6f 73 65 20 24 63 73 0a 0a 20 20 20 20 76 77 61 ose $cs.. vwa
4590: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
45a0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
45b0: 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 31 set done.} 1
45c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 ..test tlsIO-2.1
45d0: 31 20 7b 64 65 74 65 63 74 69 6e 67 20 6e 65 77 1 {detecting new
45e0: 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 74 20 6b data} {socket k
45f0: 6e 6f 77 6e 42 75 67 7d 20 7b 0a 20 20 20 20 70 nownBug} {. p
4600: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
4610: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 p} {..global soc
4620: 6b 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 0a 09 k..set sock $s..
4630: 73 65 74 20 66 20 5b 6f 70 65 6e 20 61 77 62 2e set f [open awb.
4640: 6c 6f 67 20 77 5d 0a 09 70 75 74 73 20 24 66 20 log w]..puts $f
4650: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e [catch {tls::han
4660: 64 73 68 61 6b 65 20 24 73 6f 63 6b 7d 20 65 72 dshake $sock} er
4670: 72 5d 0a 09 70 75 74 73 20 24 66 20 22 65 72 72 r]..puts $f "err
4680: 3a 20 24 65 72 72 22 0a 09 70 75 74 73 20 24 66 : $err"..puts $f
4690: 20 22 5b 74 6c 73 3a 3a 73 74 61 74 75 73 20 24 "[tls::status $
46a0: 73 6f 63 6b 5d 22 0a 09 63 6c 6f 73 65 20 24 73 sock]"..close $s
46b0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 . }.. set
46c0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
46d0: 72 65 71 75 69 72 65 20 30 20 2d 72 65 71 75 65 require 0 -reque
46e0: 73 74 20 30 20 2d 73 65 72 76 65 72 20 61 63 63 st 0 -server acc
46f0: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
4700: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
4710: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
4720: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
4730: 20 38 34 30 30 5d 0a 20 20 20 20 73 65 74 20 73 8400]. set s
4740: 6f 63 6b 20 22 22 0a 20 20 20 20 73 65 74 20 73 ock "". set s
4750: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 2 [tls::socket -
4760: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
4770: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4780: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
4790: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
47a0: 30 2e 30 2e 31 20 38 34 30 30 5d 0a 20 20 20 20 0.0.1 8400].
47b0: 76 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 20 70 vwait sock. p
47c0: 75 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 20 20 uts $s2 one.
47d0: 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 61 66 flush $s2. af
47e0: 74 65 72 20 35 30 30 0a 20 20 20 20 66 63 6f 6e ter 500. fcon
47f0: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c figure $sock -bl
4800: 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 65 74 ocking 0. set
4810: 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 result [gets $s
4820: 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 ock]. lappend
4830: 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 result [gets $s
4840: 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 ock]. fconfig
4850: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
4860: 69 6e 67 20 31 0a 20 20 20 20 70 75 74 73 20 24 ing 1. puts $
4870: 73 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 s2 two. flush
4880: 20 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 $s2. fconfig
4890: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
48a0: 69 6e 67 20 30 0a 20 20 20 20 6c 61 70 70 65 6e ing 0. lappen
48b0: 64 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 d result [gets $
48c0: 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 sock]. fconfi
48d0: 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 gure $sock -bloc
48e0: 6b 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 king 1. close
48f0: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
4900: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 s. close $soc
4910: 6b 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 k. set result
4920: 0a 7d 20 7b 6f 6e 65 20 7b 7d 20 74 77 6f 7d 0a .} {one {} two}.
4930: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 32 .test tlsIO-2.12
4940: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
4950: 3b 20 6e 6f 20 63 65 72 74 69 66 69 63 61 74 65 ; no certificate
4960: 73 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f s specified} {so
4970: 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 cket stdio pcCra
4980: 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 sh} {. remove
4990: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
49a0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
49b0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
49c0: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
49d0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
49e0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
49f0: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
4a00: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 5b 74 _out"]..set f [t
4a10: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4a20: 65 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a er accept 8828].
4a30: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
4a40: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
4a50: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
4a60: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
4a70: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
4a80: 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 $file..}..puts r
4a90: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
4aa0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
4ab0: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 er..close $f..pu
4ac0: 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 ts $x. }.
4ad0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
4ae0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
4af0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
4b00: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
4b10: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
4b20: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
4b30: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
4b40: 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d .0.1 8828} msg]}
4b50: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
4b60: 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 $msg. } else
4b70: 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 {. lappe
4b80: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
4b90: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 close $ms
4ba0: 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 g. }. lapp
4bb0: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
4bc0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
4bd0: 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 set x.} {ready
4be0: 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 done {}}..test t
4bf0: 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 lsIO-3.1 {socket
4c00: 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b conflict} {sock
4c10: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
4c20: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
4c30: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
4c40: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
4c50: 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 puts $f {. .p
4c60: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
4c70: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
4c80: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
4c90: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4ca0: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
4cb0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
4cc0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
4cd0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
4ce0: 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 ey 8828 \]".
4cf0: 70 75 74 73 20 24 66 20 7b 0a 09 70 75 74 73 20 puts $f {..puts
4d00: 72 65 61 64 79 0a 09 67 65 74 73 20 73 74 64 69 ready..gets stdi
4d10: 6e 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 n..close $f.
4d20: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
4d30: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
4d40: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
4d50: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
4d60: 74 5d 22 20 72 2b 5d 0a 20 20 20 20 67 65 74 73 t]" r+]. gets
4d70: 20 24 66 0a 20 20 20 20 73 65 74 20 78 20 5b 6c $f. set x [l
4d80: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
4d90: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
4da0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
4db0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4dc0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
4dd0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 lientKey \. .
4de0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
4df0: 38 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 828} msg] \...$m
4e00: 73 67 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 sg]. puts $f
4e10: 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 bye. close $f
4e20: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 . set x.} {1
4e30: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
4e40: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
4e50: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a lready in use}}.
4e60: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 32 20 .test tlsIO-3.2
4e70: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
4e80: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
4e90: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
4ea0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
4eb0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
4ec0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
4ed0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
4ee0: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
4ef0: 65 20 74 6c 73 0a 09 73 65 74 20 74 31 20 5b 61 e tls..set t1 [a
4f00: 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74 20 fter 30000 "set
4f10: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
4f20: 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 et t2 [after 310
4f30: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
4f40: 6f 75 74 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 out"]..set t3 [a
4f50: 66 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 fter 32000 "set
4f60: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
4f70: 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 et counter 0.
4f80: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
4f90: 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set s \[tls::soc
4fa0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
4fb0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
4fc0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
4fd0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
4fe0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
4ff0: 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 8 \]". puts $
5000: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
5010: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
5020: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
5030: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
5040: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
5050: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
5060: 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 ng line..}..proc
5070: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
5080: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
5090: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
50a0: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
50b0: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
50c0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
50d0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
50e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
50f0: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
5100: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
5110: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5120: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
5130: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
5140: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
5150: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
5160: 6c 20 24 74 31 0a 09 76 77 61 69 74 20 78 0a 09 l $t1..vwait x..
5170: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 after cancel $t2
5180: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
5190: 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f cancel $t3..clo
51a0: 73 65 20 24 73 0a 09 70 75 74 73 20 24 78 0a 20 se $s..puts $x.
51b0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
51c0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
51d0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
51e0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
51f0: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 73 ript]" r+]. s
5200: 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 et x [gets $f].
5210: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
5220: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
5230: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
5240: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
5250: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
5260: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
5270: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 27.0.0.1 8828].
5280: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5290: 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 1 -buffering lin
52a0: 65 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c e. set s2 [tl
52b0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
52c0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
52d0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
52e0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
52f0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
5300: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 127.0.0.1 8828
5310: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
5320: 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 $s2 -buffering
5330: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 line. set s3
5340: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
5350: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
5360: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
5370: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5380: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
5390: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
53a0: 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 828]. fconfig
53b0: 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 ure $s3 -bufferi
53c0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 ng line. for
53d0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
53e0: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
53f0: 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c .puts $s1 hello,
5400: 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 s1..gets $s1..pu
5410: 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a ts $s2 hello,s2.
5420: 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 .gets $s2..puts
5430: 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 $s3 hello,s3..ge
5440: 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 ts $s3. }.
5450: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 close $s1. c
5460: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
5470: 73 65 20 24 73 33 0a 20 20 20 20 6c 61 70 70 65 se $s3. lappe
5480: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
5490: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
54a0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
54b0: 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f one}..test tlsIO
54c0: 2d 34 2e 31 20 7b 73 65 72 76 65 72 20 77 69 74 -4.1 {server wit
54d0: 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 h several client
54e0: 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f s} {socket stdio
54f0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
5500: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
5510: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
5520: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
5530: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
5540: 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 equire tls..gets
5550: 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 stdin. }.
5560: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 73 20 puts $f "set s
5570: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 \[tls::socket -c
5580: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
5590: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
55a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
55b0: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
55c0: 31 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 1 8828 \]". p
55d0: 75 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e 66 69 uts $f {..fconfi
55e0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
55f0: 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 7b 73 65 ng line..for {se
5600: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 t i 0} {$i < 100
5610: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 } {incr i} {..
5620: 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a puts $s hello.
5630: 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a . gets $s..}.
5640: 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 .close $s..puts
5650: 62 79 65 0a 09 67 65 74 73 20 73 74 64 69 6e 0a bye..gets stdin.
5660: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
5670: 24 66 0a 20 20 20 20 73 65 74 20 70 31 20 5b 6f $f. set p1 [o
5680: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
5690: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
56a0: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
56b0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 31 20 fconfigure $p1
56c0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
56d0: 20 20 20 20 73 65 74 20 70 32 20 5b 6f 70 65 6e set p2 [open
56e0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
56f0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
5700: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 ipt]" r+]. fc
5710: 6f 6e 66 69 67 75 72 65 20 24 70 32 20 2d 62 75 onfigure $p2 -bu
5720: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
5730: 20 73 65 74 20 70 33 20 5b 6f 70 65 6e 20 22 7c set p3 [open "|
5740: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
5750: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
5760: 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 ]" r+]. fconf
5770: 69 67 75 72 65 20 24 70 33 20 2d 62 75 66 66 65 igure $p3 -buffe
5780: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 72 ring line. pr
5790: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
57a0: 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 } {..fconfigure
57b0: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
57c0: 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 ne..fileevent $s
57d0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
57e0: 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 7d 0a 20 echo $s]. }.
57f0: 20 20 20 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d proc echo {s}
5800: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 20 20 20 {..global x.
5810: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
5820: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 69 66 20 $s]. if
5830: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 {[eof $s]} {.
5840: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
5850: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 s. se
5860: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
5870: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
5880: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
5890: 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 7d . }. }
58a0: 0a 20 20 20 20 73 65 74 20 74 31 20 5b 61 66 74 . set t1 [aft
58b0: 65 72 20 33 30 30 30 30 20 22 73 65 74 20 78 20 er 30000 "set x
58c0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
58d0: 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 set t2 [after 31
58e0: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
58f0: 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 _out"]. set t
5900: 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 3 [after 32000 "
5910: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5920: 5d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 ]. set s [tls
5930: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
5940: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
5950: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
5960: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5970: 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 serverKey \.
5980: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
5990: 38 38 32 38 5d 0a 20 20 20 20 70 75 74 73 20 24 8828]. puts $
59a0: 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 p1 open. puts
59b0: 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 75 $p2 open. pu
59c0: 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 20 ts $p3 open.
59d0: 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 vwait x. vwai
59e0: 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a t x. vwait x.
59f0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
5a00: 20 24 74 31 0a 20 20 20 20 61 66 74 65 72 20 63 $t1. after c
5a10: 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 61 66 ancel $t2. af
5a20: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 20 ter cancel $t3.
5a30: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
5a40: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
5a50: 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 20 pend l [list p1
5a60: 5b 67 65 74 73 20 24 70 31 5d 20 24 78 5d 0a 20 [gets $p1] $x].
5a70: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
5a80: 73 74 20 70 32 20 5b 67 65 74 73 20 24 70 32 5d st p2 [gets $p2]
5a90: 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 $x]. lappend
5aa0: 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 74 l [list p3 [get
5ab0: 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 70 s $p3] $x]. p
5ac0: 75 74 73 20 24 70 31 20 62 79 65 0a 20 20 20 20 uts $p1 bye.
5ad0: 70 75 74 73 20 24 70 32 20 62 79 65 0a 20 20 20 puts $p2 bye.
5ae0: 20 70 75 74 73 20 24 70 33 20 62 79 65 0a 20 20 puts $p3 bye.
5af0: 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 20 close $p1.
5b00: 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 63 6c close $p2. cl
5b10: 6f 73 65 20 24 70 33 0a 20 20 20 20 73 65 74 20 ose $p3. set
5b20: 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 6f 6e l.} {{p1 bye don
5b30: 65 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e 65 7d e} {p2 bye done}
5b40: 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d 7d 0a {p3 bye done}}.
5b50: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e 32 20 .test tlsIO-4.2
5b60: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
5b70: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
5b80: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f bers, htons} {so
5b90: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
5ba0: 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b 63 61 x ok. if {[ca
5bb0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
5bc0: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 -server dodo 0x
5bd0: 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 3000} msg]} {..s
5be0: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
5bf0: 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d else {..close $m
5c00: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
5c10: 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c x.} ok..test tl
5c20: 73 49 4f 2d 35 2e 31 20 7b 62 79 74 65 20 6f 72 sIO-5.1 {byte or
5c30: 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f der problems, so
5c40: 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 cket numbers, ht
5c50: 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ons} \..{socket
5c60: 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 unixOnly notRoot
5c70: 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 } {. set x {c
5c80: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
5c90: 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a ket: not owner}.
5ca0: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
5cb0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
5cc0: 72 76 65 72 20 64 6f 64 6f 20 30 78 31 7d 20 6d rver dodo 0x1} m
5cd0: 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 sg]} {. s
5ce0: 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 et x {htons prob
5cf0: 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 lem, should be d
5d00: 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 isallowed, are y
5d10: 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 ou running as SU
5d20: 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 ?}..close $msg.
5d30: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
5d40: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
5d50: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
5d60: 72 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e r}.test tlsIO-5.
5d70: 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 2 {byte order pr
5d80: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
5d90: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b umbers, htons} {
5da0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
5db0: 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 t x {couldn't op
5dc0: 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 en socket: port
5dd0: 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d number too high}
5de0: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
5df0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
5e00: 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 30 30 erver dodo 0x100
5e10: 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 00} msg]} {..set
5e20: 20 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c 75 74 x {port resolut
5e30: 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f ion problem, sho
5e40: 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 uld be disallowe
5e50: 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 d}..close $msg.
5e60: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
5e70: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
5e80: 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d socket: port num
5e90: 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 74 65 ber too high}.te
5ea0: 73 74 20 74 6c 73 49 4f 2d 35 2e 33 20 7b 62 79 st tlsIO-5.3 {by
5eb0: 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d te order problem
5ec0: 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 s, socket number
5ed0: 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f s, htons} \..{so
5ee0: 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f cket unixOnly no
5ef0: 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 tRoot} {. set
5f00: 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 x {couldn't ope
5f10: 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 n socket: not ow
5f20: 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 ner}. if {![c
5f30: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
5f40: 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 32 t -server dodo 2
5f50: 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 1} msg]} {..set
5f60: 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d x {htons problem
5f70: 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 , should be disa
5f80: 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 llowed, are you
5f90: 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a running as SU?}.
5fa0: 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 .close $msg.
5fb0: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 }. set x.} {c
5fc0: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
5fd0: 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a ket: not owner}.
5fe0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 36 2e 31 20 .test tlsIO-6.1
5ff0: 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b {accept callback
6000: 20 65 72 72 6f 72 7d 20 7b 75 6e 65 78 70 6c 61 error} {unexpla
6010: 69 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b inedFailure sock
6020: 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 et stdio pcCrash
6030: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
6040: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
6050: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
6060: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
6070: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
6080: 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 equire tls..gets
6090: 20 73 74 64 69 6e 0a 09 74 6c 73 3a 3a 73 6f 63 stdin..tls::soc
60a0: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 ket 127.0.0.1 88
60b0: 34 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 48. }. clo
60c0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
60d0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
60e0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
60f0: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
6100: 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 proc bgerror
6110: 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 args {..global x
6120: 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 ..set x $args.
6130: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
6140: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 ept {s a p} {exp
6150: 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 r 10 / 0}. se
6160: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
6170: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
6180: 38 38 34 38 5d 0a 20 20 20 20 70 75 74 73 20 24 8848]. puts $
6190: 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 f hello. clos
61a0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 74 69 6d e $f. set tim
61b0: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
61c0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
61d0: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 "]. vwait x.
61e0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
61f0: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
6200: 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 $s. rename b
6210: 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 gerror {}. se
6220: 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 t x.} {{divide b
6230: 79 20 7a 65 72 6f 7d 7d 0a 0a 23 20 62 75 67 20 y zero}}..# bug
6240: 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f report #5812 fco
6250: 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 nfigure doesn't
6260: 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 return value for
6270: 20 27 2d 70 65 65 72 6e 61 6d 65 27 0a 0a 74 65 '-peername'..te
6280: 73 74 20 74 6c 73 49 4f 2d 37 2e 31 20 7b 74 65 st tlsIO-7.1 {te
6290: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
62a0: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
62b0: 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 20 knownBug socket
62c0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
62d0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
62e0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
62f0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
6300: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
6310: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
6320: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 74 }. puts $f "t
6330: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
6340: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
6350: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
6360: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
6370: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
6380: 4b 65 79 20 38 38 32 30 22 0a 20 20 20 20 70 75 Key 8820". pu
6390: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
63a0: 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 cept args {..
63b0: 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 global x.. s
63c0: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
63d0: 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 ts ready..set ti
63e0: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
63f0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
6400: 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 t"]..vwait x..af
6410: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
6420: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
6430: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
6440: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
6450: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
6460: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
6470: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
6480: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
6490: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
64a0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
64b0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
64c0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
64d0: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
64e0: 31 20 38 38 32 30 5d 0a 20 20 20 20 73 65 74 20 1 8820]. set
64f0: 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 p [fconfigure $s
6500: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 -peername].
6510: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
6520: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 se $f. set l
6530: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
6540: 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 [string compare
6550: 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 20 31 [lindex $p 0] 1
6560: 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 27.0.0.1]. la
6570: 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 ppend l [string
6580: 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 compare [lindex
6590: 24 70 20 32 5d 20 38 38 32 30 5d 0a 20 20 20 20 $p 2] 8820].
65a0: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 lappend l [lleng
65b0: 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20 33 7d th $p].} {0 0 3}
65c0: 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 23 ..# bug report #
65d0: 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 20 5812 fconfigure
65e0: 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 76 doesn't return v
65f0: 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e alue for '-sockn
6600: 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f ame'..test tlsIO
6610: 2d 37 2e 32 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.2 {testing so
6620: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
6630: 74 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 6e 42 75 67 tions} {knownBug
6640: 20 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b socket stdio} {
6650: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
6660: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
6670: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
6680: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
6690: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
66a0: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
66b0: 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b ts $f "tls::sock
66c0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
66d0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
66e0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
66f0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
6700: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 31 $serverKey 8821
6710: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
6720: 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 .proc accept arg
6730: 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 s {.. global
6740: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
6750: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
6760: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
6770: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
6780: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 timed_out"]..vwa
6790: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
67a0: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a el $timer. }.
67b0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
67c0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
67d0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
67e0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
67f0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
6800: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6810: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
6820: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
6830: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6840: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
6850: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
6860: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 31 5d 0a 127.0.0.1 8821].
6870: 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 set p [fconf
6880: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
6890: 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 me]. close $s
68a0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
68b0: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
68c0: 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 append l [llengt
68d0: 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e h $p]. lappen
68e0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 d l [lindex $p 0
68f0: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
6900: 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20 5b 6c [string equal [l
6910: 69 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 31 index $p 2] 8821
6920: 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 ].} {3 127.0.0.1
6930: 20 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 0}..test tlsIO-
6940: 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 7.3 {testing soc
6950: 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 ket specific opt
6960: 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b ions} {socket} {
6970: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6980: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
6990: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
69a0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
69b0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
69c0: 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 rKey \. .-ser
69d0: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 32 5d ver accept 8822]
69e0: 0a 20 20 20 20 73 65 74 20 6c 20 5b 66 63 6f 6e . set l [fcon
69f0: 66 69 67 75 72 65 20 24 73 5d 0a 20 20 20 20 63 figure $s]. c
6a00: 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 lose $s. upda
6a10: 74 65 0a 20 20 20 20 6c 6c 65 6e 67 74 68 20 24 te. llength $
6a20: 6c 0a 7d 20 31 32 0a 0a 23 20 62 75 67 20 72 65 l.} 12..# bug re
6a30: 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 port #5812 fconf
6a40: 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 igure doesn't re
6a50: 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 turn value for '
6a60: 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 -sockname'..test
6a70: 20 74 6c 73 49 4f 2d 37 2e 34 20 7b 74 65 73 74 tlsIO-7.4 {test
6a80: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
6a90: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b 6e fic options} {kn
6aa0: 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 7d 20 7b ownBug socket} {
6ab0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6ac0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
6ad0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
6ae0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6af0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
6b00: 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 rKey \. .-ser
6b10: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 33 5d ver accept 8823]
6b20: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
6b30: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 {s a p} {..glob
6b40: 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f al x..set x [fco
6b50: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
6b60: 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a name]..close $s.
6b70: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
6b80: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
6b90: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
6ba0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
6bb0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6bc0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
6bd0: 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 .[info hostname
6be0: 5d 20 38 38 32 33 5d 0a 20 20 20 20 73 65 74 20 ] 8823]. set
6bf0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
6c00: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
6c10: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
6c20: 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 x. after canc
6c30: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
6c40: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
6c50: 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 $s1. set l "
6c60: 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ". lappend l
6c70: 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c [lindex $x 2] [l
6c80: 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 38 38 length $x].} {88
6c90: 32 33 20 33 7d 0a 0a 23 20 62 75 67 20 72 65 70 23 3}..# bug rep
6ca0: 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 ort #5812 fconfi
6cb0: 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 gure doesn't ret
6cc0: 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d urn value for '-
6cd0: 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 sockname'..test
6ce0: 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 65 73 74 69 tlsIO-7.5 {testi
6cf0: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
6d00: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b 6e 6f ic options} {kno
6d10: 77 6e 42 75 67 20 73 6f 63 6b 65 74 20 75 6e 69 wnBug socket uni
6d20: 78 4f 72 50 63 7d 20 7b 0a 20 20 20 20 73 65 74 xOrPc} {. set
6d30: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
6d40: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 \..-certfile $se
6d50: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
6d60: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6d70: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 e $serverKey \.
6d80: 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 .-server acce
6d90: 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f pt 8829]. pro
6da0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
6db0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
6dc0: 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t x [fconfigure
6dd0: 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 $s -sockname]..c
6de0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
6df0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
6e00: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
6e10: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
6e20: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
6e30: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
6e40: 65 79 20 5c 0a 20 20 20 20 09 31 32 37 2e 30 2e ey \. .127.0.
6e50: 30 2e 31 20 38 38 32 39 5d 0a 20 20 20 20 73 65 0.1 8829]. se
6e60: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
6e70: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
6e80: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
6e90: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
6ea0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
6eb0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
6ec0: 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c se $s1. set l
6ed0: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
6ee0: 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 5d 20 l [lindex $x 0]
6ef0: 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c [lindex $x 2] [l
6f00: 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 31 32 length $x].} {12
6f10: 37 2e 30 2e 30 2e 31 20 38 38 32 39 20 33 7d 0a 7.0.0.1 8829 3}.
6f20: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 38 2e 31 20 .test tlsIO-8.1
6f30: 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 63 20 {testing -async
6f40: 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 73 7d flag on sockets}
6f50: 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e {unexplainedHan
6f60: 67 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 g socket} {.
6f70: 23 20 74 65 73 74 20 73 65 65 6d 73 20 74 6f 20 # test seems to
6f80: 68 61 6e 67 20 2d 2d 20 61 77 62 20 36 2f 32 2f hang -- awb 6/2/
6f90: 32 30 30 30 0a 20 20 20 20 23 20 4e 4f 54 45 3a 2000. # NOTE:
6fa0: 20 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 This test may f
6fb0: 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 ail on some Sola
6fc0: 72 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e ris 2.4 systems.
6fd0: 20 49 66 20 69 74 20 64 6f 65 73 2c 0a 20 20 20 If it does,.
6fe0: 20 23 20 63 68 65 63 6b 20 74 68 61 74 20 79 6f # check that yo
6ff0: 75 20 68 61 76 65 20 74 68 65 73 65 20 70 61 74 u have these pat
7000: 63 68 65 73 20 69 6e 73 74 61 6c 6c 65 64 20 28 ches installed (
7010: 75 73 69 6e 67 20 73 68 6f 77 72 65 76 20 2d 70 using showrev -p
7020: 29 3a 0a 20 20 20 20 23 0a 20 20 20 20 23 20 31 ):. #. # 1
7030: 30 31 39 30 37 2d 30 35 2c 20 31 30 31 39 32 35 01907-05, 101925
7040: 2d 30 32 2c 20 31 30 31 39 34 35 2d 31 34 2c 20 -02, 101945-14,
7050: 31 30 31 39 35 39 2d 30 33 2c 20 31 30 31 39 36 101959-03, 10196
7060: 39 2d 30 35 2c 20 31 30 31 39 37 33 2d 30 33 2c 9-05, 101973-03,
7070: 0a 20 20 20 20 23 20 31 30 31 39 37 37 2d 30 33 . # 101977-03
7080: 2c 20 31 30 31 39 38 31 2d 30 32 2c 20 31 30 31 , 101981-02, 101
7090: 39 38 35 2d 30 31 2c 20 31 30 32 30 30 31 2d 30 985-01, 102001-0
70a0: 33 2c 20 31 30 32 30 30 33 2d 30 31 2c 20 31 30 3, 102003-01, 10
70b0: 32 30 30 37 2d 30 31 2c 0a 20 20 20 20 23 20 31 2007-01,. # 1
70c0: 30 32 30 31 31 2d 30 32 2c 20 31 30 32 30 32 34 02011-02, 102024
70d0: 2d 30 31 2c 20 31 30 32 30 33 39 2d 30 31 2c 20 -01, 102039-01,
70e0: 31 30 32 30 34 34 2d 30 31 2c 20 31 30 32 30 34 102044-01, 10204
70f0: 38 2d 30 31 2c 20 31 30 32 30 36 32 2d 30 33 2c 8-01, 102062-03,
7100: 0a 20 20 20 20 23 20 31 30 32 30 36 36 2d 30 34 . # 102066-04
7110: 2c 20 31 30 32 30 37 30 2d 30 31 2c 20 31 30 32 , 102070-01, 102
7120: 31 30 35 2d 30 31 2c 20 31 30 32 31 35 33 2d 30 105-01, 102153-0
7130: 33 2c 20 31 30 32 32 31 36 2d 30 31 2c 20 31 30 3, 102216-01, 10
7140: 32 32 33 32 2d 30 31 2c 0a 20 20 20 20 23 20 31 2232-01,. # 1
7150: 30 31 38 37 38 2d 30 33 2c 20 31 30 31 38 37 39 01878-03, 101879
7160: 2d 30 31 2c 20 31 30 31 38 38 30 2d 30 33 2c 20 -01, 101880-03,
7170: 31 30 31 39 33 33 2d 30 31 2c 20 31 30 31 39 35 101933-01, 10195
7180: 30 2d 30 31 2c 20 31 30 32 30 33 30 2d 30 31 2c 0-01, 102030-01,
7190: 0a 20 20 20 20 23 20 31 30 32 30 35 37 2d 30 38 . # 102057-08
71a0: 2c 20 31 30 32 31 34 30 2d 30 31 2c 20 31 30 31 , 102140-01, 101
71b0: 39 32 30 2d 30 32 2c 20 31 30 31 39 32 31 2d 30 920-02, 101921-0
71c0: 39 2c 20 31 30 31 39 32 32 2d 30 37 2c 20 31 30 9, 101922-07, 10
71d0: 31 39 32 33 2d 30 33 0a 20 20 20 20 23 0a 20 20 1923-03. #.
71e0: 20 20 23 20 49 66 20 61 66 74 65 72 20 69 6e 73 # If after ins
71f0: 74 61 6c 6c 69 6e 67 20 74 68 65 73 65 20 70 61 talling these pa
7200: 74 63 68 65 73 20 79 6f 75 20 61 72 65 20 73 74 tches you are st
7210: 69 6c 6c 20 65 78 70 65 72 69 65 6e 63 69 6e 67 ill experiencing
7220: 20 61 0a 20 20 20 20 23 20 70 72 6f 62 6c 65 6d a. # problem
7230: 2c 20 70 6c 65 61 73 65 20 65 6d 61 69 6c 20 6a , please email j
7240: 79 6c 40 65 6e 67 2e 73 75 6e 2e 63 6f 6d 2e 20 yl@eng.sun.com.
7250: 57 65 20 68 61 76 65 20 6e 6f 74 20 6f 62 73 65 We have not obse
7260: 72 76 65 64 20 74 68 69 73 0a 20 20 20 20 23 20 rved this. #
7270: 66 61 69 6c 75 72 65 20 6f 6e 20 53 6f 6c 61 72 failure on Solar
7280: 69 73 20 32 2e 35 2c 20 73 6f 20 61 6e 6f 74 68 is 2.5, so anoth
7290: 65 72 20 6f 70 74 69 6f 6e 20 28 69 6e 73 74 65 er option (inste
72a0: 61 64 20 6f 66 20 69 6e 73 74 61 6c 6c 69 6e 67 ad of installing
72b0: 0a 20 20 20 20 23 20 74 68 65 73 65 20 70 61 74 . # these pat
72c0: 63 68 65 73 29 20 69 73 20 74 6f 20 75 70 67 72 ches) is to upgr
72d0: 61 64 65 20 74 6f 20 53 6f 6c 61 72 69 73 20 32 ade to Solaris 2
72e0: 2e 35 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 .5.. set s [t
72f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
7300: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
7310: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
7320: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
7330: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d rverKey \. .-
7340: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
7350: 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 30]. proc acc
7360: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
7370: 6c 6f 62 61 6c 20 78 0a 09 70 75 74 73 20 24 73 lobal x..puts $s
7380: 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 09 bye..close $s..
7390: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d set x done. }
73a0: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
73b0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
73c0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
73d0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
73e0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
73f0: 6e 74 4b 65 79 20 5c 0a 09 2d 61 73 79 6e 63 20 ntKey \..-async
7400: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
7410: 38 38 33 30 5d 0a 20 20 20 20 76 77 61 69 74 20 8830]. vwait
7420: 78 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65 74 x. set z [get
7430: 73 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 s $s1]. close
7440: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
7450: 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 1. set z.} by
7460: 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e e..test tlsIO-9.
7470: 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 1 {testing spuri
7480: 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 75 6e 65 ous events} {une
7490: 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f 63 xplainedHang soc
74a0: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 6c 6f 63 ket} {. # loc
74b0: 6b 73 20 75 70 20 0a 20 20 20 20 73 65 74 20 6c ks up . set l
74c0: 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 en 0. set spu
74d0: 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 rious 0. set
74e0: 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 done 0. proc
74f0: 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b readlittle {s} {
7500: 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 ..global spuriou
7510: 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 s done len..set
7520: 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 l [read $s 1]..i
7530: 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 f {[string lengt
7540: 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 h $l] == 0} {..
7550: 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d if {![eof $s]
7560: 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 } {...incr spuri
7570: 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ous.. } else
7580: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 {...close $s...s
7590: 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d et done 1.. }
75a0: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
75b0: 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 incr len [string
75c0: 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 length $l]..}.
75d0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 }. proc ac
75e0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
75f0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
7600: 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 20 2d 62 uffering none -b
7610: 6c 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 66 69 6c locking off..fil
7620: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
7630: 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 le [list readlit
7640: 74 6c 65 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 tle $s]. }.
7650: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
7660: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
7670: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
7680: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7690: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
76a0: 79 20 5c 0a 20 20 20 09 2d 73 65 72 76 65 72 20 y \. .-server
76b0: 61 63 63 65 70 74 20 38 38 33 31 5d 0a 20 20 20 accept 8831].
76c0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
76d0: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
76e0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
76f0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7700: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
7710: 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f \. .[info ho
7720: 73 74 6e 61 6d 65 5d 20 38 38 33 31 5d 0a 20 20 stname] 8831].
7730: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
7740: 65 20 24 63 20 30 31 32 33 34 35 36 37 38 39 30 e $c 01234567890
7750: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
7760: 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 7890123456789012
7770: 33 34 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 73 3456789. clos
7780: 65 20 24 63 0a 20 20 20 20 73 65 74 20 74 69 6d e $c. set tim
7790: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
77a0: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
77b0: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
77c0: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
77d0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
77e0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 close $s. li
77f0: 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 st $spurious $le
7800: 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 n.} {0 50}..test
7810: 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 73 74 tlsIO-9.2 {test
7820: 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c ing async write,
7830: 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 fileevents, flu
7840: 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f sh on close} {so
7850: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
7860: 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a 20 20 firstblock "".
7870: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
7880: 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 20 69 {$i < 5} {incr i
7890: 7d 20 7b 73 65 74 20 66 69 72 73 74 62 6c 6f 63 } {set firstbloc
78a0: 6b 20 22 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 k "a$firstblock$
78b0: 66 69 72 73 74 62 6c 6f 63 6b 22 7d 0a 20 20 20 firstblock"}.
78c0: 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b set secondblock
78d0: 20 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 "". for {set
78e0: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d 20 i 0} {$i < 16}
78f0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 73 65 74 20 {incr i} {..set
7900: 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 secondblock "b$s
7910: 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e econdblock$secon
7920: 64 62 6c 6f 63 6b 22 0a 20 20 20 20 7d 0a 20 20 dblock". }.
7930: 20 20 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f set l [tls::so
7940: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
7950: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
7960: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7970: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
7980: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
7990: 20 61 63 63 65 70 74 20 38 38 33 32 5d 0a 20 20 accept 8832].
79a0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
79b0: 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 a p} {..fconfig
79c0: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
79d0: 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 0 -translation
79e0: 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 lf -buffersize 1
79f0: 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 6384 \...-buffer
7a00: 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 ing line..fileev
7a10: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
7a20: 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 20 20 "readable $s".
7a30: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 }. proc rea
7a40: 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 74 dable {s} {..set
7a50: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 66 69 l [gets $s]..fi
7a60: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
7a70: 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 ble {}..after 10
7a80: 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 00 respond $s.
7a90: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 }. proc res
7aa0: 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 pond {s} {..glob
7ab0: 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 70 al firstblock..p
7ac0: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
7ad0: 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 s $firstblock..a
7ae0: 66 74 65 72 20 31 30 30 30 20 77 72 69 74 65 64 fter 1000 writed
7af0: 61 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ata $s. }.
7b00: 20 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 proc writedata
7b10: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 {s} {..global se
7b20: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 74 73 20 condblock..puts
7b30: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 -nonewline $s $s
7b40: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 econdblock..clos
7b50: 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 e $s. }. s
7b60: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
7b70: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
7b80: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7b90: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7ba0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
7bb0: 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 . .[info host
7bc0: 6e 61 6d 65 5d 20 38 38 33 32 5d 0a 20 20 20 20 name] 8832].
7bd0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
7be0: 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 locking 0 -trans
7bf0: 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c lf -buffering l
7c00: 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e ine. set coun
7c10: 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 t 0. puts $s
7c20: 68 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 hello. proc r
7c30: 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f eadit {s} {..glo
7c40: 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 bal count done..
7c50: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a set l [read $s].
7c60: 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 .incr count [str
7c70: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 ing length $l]..
7c80: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
7c90: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 . close $s..
7ca0: 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d set done 1..}
7cb0: 0a 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 . }. filee
7cc0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
7cd0: 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 "readit $s".
7ce0: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
7cf0: 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 10000 "set don
7d00: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
7d10: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
7d20: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
7d30: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
7d40: 6c 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a l. set count.
7d50: 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 74 6c } 65566..test tl
7d60: 73 49 4f 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 sIO-9.3 {testing
7d70: 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d EOF stickyness}
7d80: 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e {unexplainedHan
7d90: 67 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 g socket} {.
7da0: 23 20 68 61 6e 67 73 0a 20 20 20 20 70 72 6f 63 # hangs. proc
7db0: 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 count_to_eof {s
7dc0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e } {..global coun
7dd0: 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 t done timer..se
7de0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 t l [gets $s]..i
7df0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
7e00: 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 incr count..
7e10: 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e if {$count >
7e20: 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 9} {...close $s
7e30: 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 ...set done true
7e40: 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f ...set count {eo
7e50: 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 f is sticky}...a
7e60: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
7e70: 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 er.. }..}.
7e80: 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 }. proc time
7e90: 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 rproc {} {..glob
7ea0: 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a al done count c.
7eb0: 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 .set done true..
7ec0: 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 set count {timer
7ed0: 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 went off, eof i
7ee0: 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 s not sticky}..c
7ef0: 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 0a 20 lose $c. }..
7f00: 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 set count 0.
7f10: 20 20 20 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 set done fals
7f20: 65 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 e. proc write
7f30: 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 _then_close {s}
7f40: 7b 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 {..puts $s bye..
7f50: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 close $s. }.
7f60: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
7f70: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
7f80: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
7f90: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
7fa0: 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 tion lf..fileeve
7fb0: 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 nt $s writable "
7fc0: 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 write_then_close
7fd0: 20 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 $s". }. s
7fe0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
7ff0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
8000: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
8010: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
8020: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
8030: 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 . .-server ac
8040: 63 65 70 74 20 38 38 33 33 5d 0a 20 20 20 20 73 cept 8833]. s
8050: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
8060: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
8070: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
8080: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
8090: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
80a0: 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 . .[info host
80b0: 6e 61 6d 65 5d 20 38 38 33 33 5d 0a 20 20 20 20 name] 8833].
80c0: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 fconfigure $c -b
80d0: 6c 6f 63 6b 69 6e 67 20 6f 66 66 20 2d 62 75 66 locking off -buf
80e0: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
80f0: 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 nslation lf.
8100: 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 fileevent $c rea
8110: 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f dable "count_to_
8120: 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 eof $c". set
8130: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
8140: 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 0 timerproc].
8150: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
8160: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 close $s. set
8170: 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 count.} {eof is
8180: 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 sticky}..remove
8190: 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 File script..tes
81a0: 74 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 65 t tlsIO-10.1 {te
81b0: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 63 sting socket acc
81c0: 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 ept callback err
81d0: 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f or handling} {so
81e0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
81f0: 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 goterror 0. p
8200: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 roc bgerror args
8210: 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f {global goterro
8220: 72 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 r; set goterror
8230: 31 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 1}. set s [tl
8240: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
8250: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
8260: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8270: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
8280: 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 verKey \. .-s
8290: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 39 erver accept 889
82a0: 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 8]. proc acce
82b0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 pt {s a p} {clos
82c0: 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a 20 20 20 e $s; error}.
82d0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
82e0: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
82f0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
8300: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8310: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
8320: 20 5c 0a 09 31 32 37 2e 30 2e 30 2e 31 20 38 38 \..127.0.0.1 88
8330: 39 38 5d 0a 20 20 20 20 76 77 61 69 74 20 67 6f 98]. vwait go
8340: 74 65 72 72 6f 72 0a 20 20 20 20 63 6c 6f 73 65 terror. close
8350: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 $s. close $c
8360: 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f . set goterro
8370: 72 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 r.} 1..test tlsI
8380: 4f 2d 31 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e O-11.1 {tcp conn
8390: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 ection} {socket
83a0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
83b0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
83c0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
83d0: 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a caCert $caCert".
83e0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
83f0: 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 "set serverCert
8400: 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 $serverCert".
8410: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
8420: 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c t clientCert $cl
8430: 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 ientCert". se
8440: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
8450: 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 erverKey $server
8460: 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d Key". sendCom
8470: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
8480: 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a Key $clientKey".
8490: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
84a0: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 31 {..set socket9_1
84b0: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
84c0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
84d0: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 r accept \...-ce
84e0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
84f0: 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 rt \...-cafile $
8500: 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 caCert \...-keyf
8510: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
8520: 0a 09 09 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 ...8834]..proc a
8530: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
8540: 09 20 20 20 20 70 75 74 73 20 24 73 20 64 6f 6e . puts $s don
8550: 65 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 e.. tls::hand
8560: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 63 6c shake $s.. cl
8570: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
8580: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
8590: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
85a0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
85b0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
85c0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
85d0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
85e0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
85f0: 38 33 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 834]. set r [
8600: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f gets $s]. clo
8610: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
8620: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
8630: 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 cket9_1_test_ser
8640: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d ver}. set r.}
8650: 20 64 6f 6e 65 0a 0a 74 65 73 74 20 74 6c 73 49 done..test tlsI
8660: 4f 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 O-11.2 {client s
8670: 70 65 63 69 66 69 65 73 20 69 74 73 20 70 6f 72 pecifies its por
8680: 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 t} {socket doTes
8690: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
86a0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
86b0: 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 mmand "set caCer
86c0: 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 t $caCert". s
86d0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
86e0: 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 serverCert $serv
86f0: 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 erCert". send
8700: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
8710: 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 entCert $clientC
8720: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
8730: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
8740: 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a Key $serverKey".
8750: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8760: 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 "set clientKey $
8770: 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 69 clientKey". i
8780: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
8790: 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 port]} {..incr p
87a0: 6f 72 74 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ort. } else {
87b0: 0a 09 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72 ..set port [expr
87c0: 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 $tlsServerPort
87d0: 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 + [pid]%1024].
87e0: 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d }. sendComm
87f0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
8800: 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_2_test_server
8810: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
8820: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
8830: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
8840: 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 erCert \...-cafi
8850: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d le $caCert \...-
8860: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8870: 65 79 20 5c 0a 09 20 20 20 20 38 38 33 35 5d 0a ey \.. 8835].
8880: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
8890: 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a a p} {.. tls:
88a0: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
88b0: 20 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 puts $s $p..
88c0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
88d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
88e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
88f0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
8900: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
8910: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8920: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
8930: 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 -myport $por
8940: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
8950: 50 20 38 38 33 35 5d 0a 20 20 20 20 73 65 74 20 P 8835]. set
8960: 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 r [gets $s].
8970: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e close $s. sen
8980: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
8990: 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f $socket9_2_test_
89a0: 73 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b server}. if {
89b0: 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 $r == $port} {..
89c0: 73 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 set result ok.
89d0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
89e0: 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 result broken.
89f0: 20 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 }. set resu
8a00: 6c 74 0a 7d 20 6f 6b 0a 74 65 73 74 20 74 6c 73 lt.} ok.test tls
8a10: 49 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 IO-11.3 {trying
8a20: 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 to connect, no s
8a30: 65 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 erver} {socket d
8a40: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
8a50: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
8a60: 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 t status ok.
8a70: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 if {![catch {set
8a80: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
8a90: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
8aa0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
8ab0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8ac0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
8ad0: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
8ae0: 65 72 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d erverIp 8836]}]}
8af0: 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 {..if {![catch
8b00: 7b 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 {gets $s}]} {..
8b10: 20 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 set status br
8b20: 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 oken..}..close $
8b30: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
8b40: 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 status.} ok..tes
8b50: 74 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 t tlsIO-11.4 {re
8b60: 6d 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c mote echo, one l
8b70: 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ine} {socket doT
8b80: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
8b90: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
8ba0: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 Command "set caC
8bb0: 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 ert $caCert".
8bc0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
8bd0: 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 t serverCert $se
8be0: 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 rverCert". se
8bf0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
8c00: 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e lientCert $clien
8c10: 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 tCert". sendC
8c20: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
8c30: 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 erKey $serverKey
8c40: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
8c50: 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 d "set clientKey
8c60: 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 $clientKey".
8c70: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 20 sendCommand {.
8c80: 20 20 20 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 .global serve
8c90: 72 43 65 72 74 0a 09 67 6c 6f 62 61 6c 20 63 61 rCert..global ca
8ca0: 43 65 72 74 0a 09 67 6c 6f 62 61 6c 20 73 65 72 Cert..global ser
8cb0: 76 65 72 4b 65 79 0a 09 73 65 74 20 73 6f 63 6b verKey..set sock
8cc0: 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 et10_6_test_serv
8cd0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
8ce0: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
8cf0: 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 erverCert \...-c
8d00: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
8d10: 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 ..-keyfile $serv
8d20: 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 erKey \...-serve
8d30: 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 r accept 8836]..
8d40: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
8d50: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
8d60: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
8d70: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
8d80: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
8d90: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
8da0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
8db0: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
8dc0: 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 lation crlf..}..
8dd0: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
8de0: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
8df0: 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 $s].. if {[e
8e00: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 of $s]} {...clos
8e10: 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 e $s.. } else
8e20: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a {...puts $s $l.
8e30: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
8e40: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
8e50: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
8e60: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
8e70: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
8e80: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
8e90: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
8ea0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
8eb0: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
8ec0: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
8ed0: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
8ee0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 ing line. put
8ef0: 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 s $f hello. s
8f00: 65 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 et r [gets $f].
8f10: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
8f20: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
8f30: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 se $socket10_6_t
8f40: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
8f50: 73 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 set r.} hello..t
8f60: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b est tlsIO-11.5 {
8f70: 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 remote echo, 50
8f80: 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 lines} {socket d
8f90: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
8fa0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
8fb0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
8fc0: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
8fd0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8fe0: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
8ff0: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
9000: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
9010: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
9020: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
9030: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
9040: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
9050: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
9060: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
9070: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
9080: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9090: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 ..set socket10_7
90a0: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
90b0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
90c0: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 r accept \...-ce
90d0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
90e0: 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 rt \...-cafile $
90f0: 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 caCert \...-keyf
9100: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
9110: 0a 09 09 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 ...8836]..proc a
9120: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
9130: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
9140: 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 ake $s.. file
9150: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
9160: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
9170: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
9180: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
9190: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
91a0: 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 crlf..}..proc e
91b0: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 cho {s} {.. s
91c0: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
91d0: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
91e0: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
91f0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 } else {...p
9200: 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d uts $s $l.. }
9210: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
9220: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
9230: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
9240: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
9250: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9260: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
9270: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
9280: 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 ServerIP 8836].
9290: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
92a0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 -translation cr
92b0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
92c0: 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 ne. for {set
92d0: 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 cnt 0} {$cnt < 5
92e0: 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 0} {incr cnt} {.
92f0: 09 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c .puts $f "hello,
9300: 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 $cnt"..if {[str
9310: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 ing compare [get
9320: 73 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 s $f] "hello, $c
9330: 6e 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 nt"] != 0} {..
9340: 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d break..}. }
9350: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
9360: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
9370: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 lose $socket10_7
9380: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
9390: 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a set cnt.} 50..
93a0: 23 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b # Macintosh sock
93b0: 65 74 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 ets can have mor
93c0: 65 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 e than one serve
93d0: 72 20 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 r per port.if {$
93e0: 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 tcl_platform(pla
93f0: 74 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e tform) == "macin
9400: 74 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 tosh"} {. set
9410: 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 conflictResult
9420: 7b 30 20 38 38 33 36 7d 0a 7d 20 65 6c 73 65 20 {0 8836}.} else
9430: 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 {. set confli
9440: 63 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 ctResult {1 {cou
9450: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
9460: 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 t: address alrea
9470: 64 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 dy in use}}.}..t
9480: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 7b est tlsIO-11.6 {
9490: 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d socket conflict}
94a0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
94b0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
94c0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b } {. set s1 [
94d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
94e0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
94f0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9500: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9510: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
9520: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
9530: 70 74 20 38 38 33 36 5d 0a 20 20 20 20 69 66 20 pt 8836]. if
9540: 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 {[catch {set s2
9550: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9560: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
9570: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
9580: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9590: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
95a0: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
95b0: 65 70 74 20 38 38 33 36 5d 7d 20 6d 73 67 5d 7d ept 8836]} msg]}
95c0: 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b {..set result [
95d0: 6c 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 list 1 $msg].
95e0: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 } else {..set r
95f0: 65 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c esult [list 0 [l
9600: 69 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 index [fconfigur
9610: 65 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d e $s2 -sockname]
9620: 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 2]]..close $s2.
9630: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
9640: 24 73 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 $s1. set resu
9650: 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 lt.} $conflictRe
9660: 73 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f sult..test tlsIO
9670: 2d 31 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 -11.7 {server wi
9680: 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e th several clien
9690: 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ts} {socket doTe
96a0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
96b0: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
96c0: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
96d0: 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 cket10_9_test_se
96e0: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
96f0: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
9700: 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d [file join [pwd]
9710: 20 63 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 certs server.pe
9720: 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b m] \...-cafile [
9730: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9740: 63 65 72 74 73 20 63 61 46 69 6c 65 2e 70 65 6d certs caFile.pem
9750: 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b ] \...-keyfile [
9760: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9770: 63 65 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 certs skey.pem]
9780: 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 \...-server acce
9790: 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 pt 8836]..proc a
97a0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
97b0: 09 20 20 20 20 23 20 68 61 6e 64 73 68 61 6b 65 . # handshake
97c0: 20 6c 6f 63 6b 73 20 75 70 20 74 68 65 20 74 68 locks up the th
97d0: 72 65 65 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 ree synchronous
97e0: 63 6c 69 65 6e 74 73 0a 09 20 20 20 20 23 20 74 clients.. # t
97f0: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
9800: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
9810: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
9820: 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 ine.. fileeve
9830: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
9840: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d list echo $s]..}
9850: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
9860: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
9870: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b ts $s].. if {
9880: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
9890: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
98a0: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 se {...puts $s $
98b0: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 l.. }..}.
98c0: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
98d0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
98e0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
98f0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
9900: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9910: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
9920: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
9930: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e P 8836]. fcon
9940: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 figure $s1 -buff
9950: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
9960: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
9970: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
9980: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
9990: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
99a0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
99b0: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
99c0: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
99d0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
99e0: 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s2 -buffering l
99f0: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b ine. set s3 [
9a00: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9a10: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
9a20: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
9a30: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9a40: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
9a50: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
9a60: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 rIP 8836]. fc
9a70: 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 onfigure $s3 -bu
9a80: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
9a90: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
9aa0: 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 $i < 100} {incr
9ab0: 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 i} {..puts $s1 h
9ac0: 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 ello,s1..gets $s
9ad0: 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 1..puts $s2 hell
9ae0: 6f 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 o,s2..gets $s2..
9af0: 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 puts $s3 hello,s
9b00: 33 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 3..gets $s3.
9b10: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a }. close $s1.
9b20: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
9b30: 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 close $s3.
9b40: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
9b50: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f 74 se $socket10_9_t
9b60: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
9b70: 73 65 74 20 69 0a 7d 20 31 30 30 20 20 20 20 0a set i.} 100 .
9b80: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 38 .test tlsIO-11.8
9b90: 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 73 65 {client with se
9ba0: 76 65 72 61 6c 20 73 65 72 76 65 72 73 7d 20 7b veral servers} {
9bb0: 75 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 unexplainedHang
9bc0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9bd0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9be0: 7b 0a 20 20 20 20 23 20 74 68 69 73 20 6f 6e 65 {. # this one
9bf0: 20 73 65 65 6d 73 20 74 6f 20 68 61 6e 67 20 2d seems to hang -
9c00: 2d 20 61 77 62 20 36 2f 32 2f 32 30 30 30 0a 20 - awb 6/2/2000.
9c10: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9c20: 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 ..set s1 [tls::s
9c30: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
9c40: 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b ile [file join [
9c50: 70 77 64 5d 20 63 65 72 74 73 20 73 65 72 76 65 pwd] certs serve
9c60: 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 r.pem] \...-cafi
9c70: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
9c80: 77 64 5d 20 63 65 72 74 73 20 63 61 46 69 6c 65 wd] certs caFile
9c90: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 .pem] \...-keyfi
9ca0: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
9cb0: 77 64 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 wd] certs skey.p
9cc0: 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 em] \...-server
9cd0: 22 61 63 63 65 70 74 20 34 30 30 33 22 20 34 30 "accept 4003" 40
9ce0: 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 03]..set s2 [tls
9cf0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 ::socket \...-ce
9d00: 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 rtfile [file joi
9d10: 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 65 n [pwd] certs se
9d20: 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 rver.pem] \...-c
9d30: 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e afile [file join
9d40: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 46 [pwd] certs caF
9d50: 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 ile.pem] \...-ke
9d60: 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e yfile [file join
9d70: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b 65 [pwd] certs ske
9d80: 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 y.pem] \...-serv
9d90: 65 72 20 22 61 63 63 65 70 74 20 34 30 30 34 22 er "accept 4004"
9da0: 20 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 4004]..set s3 [
9db0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
9dc0: 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 -certfile [file
9dd0: 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 join [pwd] certs
9de0: 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 server.pem] \..
9df0: 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a .-cafile [file j
9e00: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9e10: 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 caFile.pem] \...
9e20: 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a -keyfile [file j
9e30: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9e40: 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 skey.pem] \...-s
9e50: 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 erver "accept 40
9e60: 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 20 05" 4005]..proc
9e70: 61 63 63 65 70 74 20 7b 6d 70 20 73 20 61 20 70 accept {mp s a p
9e80: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
9e90: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
9ea0: 70 75 74 73 20 24 73 20 24 6d 70 0a 09 20 20 20 puts $s $mp..
9eb0: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
9ec0: 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 }. set s1 [t
9ed0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9ee0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9ef0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9f00: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9f10: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9f20: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9f30: 49 50 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 IP 4003]. set
9f40: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
9f50: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
9f60: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
9f70: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9f80: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
9f90: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
9fa0: 53 65 72 76 65 72 49 50 20 34 30 30 34 5d 0a 20 ServerIP 4004].
9fb0: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
9fc0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9fd0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9fe0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9ff0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
a000: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
a010: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 remoteServerIP 4
a020: 30 30 35 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 005]. set l "
a030: 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ". lappend l
a040: 5b 67 65 74 73 20 24 73 31 5d 20 5b 67 65 74 73 [gets $s1] [gets
a050: 20 24 73 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 $s1] [eof $s1]
a060: 5b 67 65 74 73 20 24 73 32 5d 20 5b 67 65 74 73 [gets $s2] [gets
a070: 20 24 73 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 $s2] [eof $s2]
a080: 5c 0a 09 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 \..[gets $s3] [g
a090: 65 74 73 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 ets $s3] [eof $s
a0a0: 33 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 3]. close $s1
a0b0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 . close $s2.
a0c0: 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 close $s3.
a0d0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
a0e0: 63 6c 6f 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 close $s1..close
a0f0: 20 24 73 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a $s2..close $s3.
a100: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a }. set l.
a110: 7d 20 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 } {4003 {} 1 400
a120: 34 20 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 4 {} 1 4005 {} 1
a130: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 }..test tlsIO-11
a140: 2e 39 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 .9 {accept callb
a150: 61 63 6b 20 65 72 72 6f 72 7d 20 7b 6b 6e 6f 77 ack error} {know
a160: 6e 42 75 67 20 73 6f 63 6b 65 74 20 64 6f 54 65 nBug socket doTe
a170: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
a180: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ver} {. set s
a190: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
a1a0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
a1b0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
a1c0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a1d0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
a1e0: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
a1f0: 63 65 70 74 20 38 38 33 36 5d 0a 20 20 20 20 70 cept 8836]. p
a200: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
a210: 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d p} {expr 10 / 0}
a220: 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f . proc bgerro
a230: 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c r args {..global
a240: 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a x..set x $args.
a250: 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f }. sendCo
a260: 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 mmand "set caCer
a270: 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 t $caCert". s
a280: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
a290: 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 serverCert $serv
a2a0: 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 erCert". send
a2b0: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
a2c0: 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 entCert $clientC
a2d0: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a2e0: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
a2f0: 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a Key $serverKey".
a300: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a310: 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 "set clientKey $
a320: 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 69 clientKey". i
a330: 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 f {[catch {sendC
a340: 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 ommand {.. se
a350: 74 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e t peername [fcon
a360: 66 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f figure $callerSo
a370: 63 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a cket -peername].
a380: 09 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
a390: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
a3a0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
a3b0: 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 t \...-cafile $c
a3c0: 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 aCert \...-keyfi
a3d0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
a3e0: 09 20 20 20 20 09 5b 6c 69 6e 64 65 78 20 24 70 . .[lindex $p
a3f0: 65 65 72 6e 61 6d 65 20 30 5d 20 38 38 33 36 5d eername 0] 8836]
a400: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 .. close $s.
a410: 20 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a . }} msg]} {.
a420: 09 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 .close $s..error
a430: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
a440: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
a450: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
a460: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
a470: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
a480: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
a490: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 close $s. r
a4a0: 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d ename bgerror {}
a4b0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 . set x.} {{d
a4c0: 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a ivide by zero}}.
a4d0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
a4e0: 30 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 0 {testing socke
a4f0: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
a500: 6e 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 ns} {unexplained
a510: 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 Failure socket d
a520: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
a530: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
a540: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
a550: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
a560: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a570: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
a580: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
a590: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a5a0: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
a5b0: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
a5c0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
a5d0: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
a5e0: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
a5f0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
a600: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
a610: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
a620: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 ..set socket10_1
a630: 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 2_test_server [t
a640: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
a650: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
a660: 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 Cert \...-cafile
a670: 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 $caCert \...-ke
a680: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
a690: 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 \...-server acc
a6a0: 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 ept 8836]..proc
a6b0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
a6c0: 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 7d 0a close $s}. }.
a6d0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
a6e0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
a6f0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
a700: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
a710: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
a720: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
a730: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
a740: 38 33 36 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 836]. set p [
a750: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 fconfigure $s -p
a760: 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 eername]. set
a770: 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 n [fconfigure $
a780: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 s -sockname].
a790: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
a7a0: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
a7b0: 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 $p 2] [llength $
a7c0: 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a p] [llength $p].
a7d0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
a7e0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
a7f0: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 ose $socket10_12
a800: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
a810: 20 20 73 65 74 20 6c 0a 7d 20 7b 38 38 33 36 20 set l.} {8836
a820: 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 3 3}..test tlsIO
a830: 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 -11.11 {testing
a840: 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d spurious events}
a850: 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e {unexplainedHan
a860: 67 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 g socket doTests
a870: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
a880: 7d 20 7b 0a 20 20 20 20 23 20 68 61 6e 67 73 0a } {. # hangs.
a890: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a8a0: 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 "set caCert $caC
a8b0: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a8c0: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
a8d0: 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 Cert $serverCert
a8e0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a8f0: 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 d "set clientCer
a900: 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 t $clientCert".
a910: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a920: 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 set serverKey $s
a930: 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 erverKey". se
a940: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
a950: 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 lientKey $client
a960: 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d Key". sendCom
a970: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
a980: 65 74 31 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 et10_13_test_ser
a990: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
a9a0: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
a9b0: 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d serverCert \...-
a9c0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
a9d0: 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 ...-keyfile $ser
a9e0: 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 verKey \...-serv
a9f0: 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a er accept 8836].
aa00: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
aa10: 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a a p} {.. tls:
aa20: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
aa30: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
aa40: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 -translation "a
aa50: 75 74 6f 20 6c 66 22 0a 09 20 20 20 20 61 66 74 uto lf".. aft
aa60: 65 72 20 31 30 30 20 77 72 69 74 65 73 6f 6d 65 er 100 writesome
aa70: 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 $s..}..proc wri
aa80: 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 tesome {s} {..
aa90: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
aaa0: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
aab0: 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 i} {...puts $s
aac0: 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 "line $i from re
aad0: 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 mote server"..
aae0: 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 }.. close $
aaf0: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
ab00: 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 et len 0. set
ab10: 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 spurious 0.
ab20: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
ab30: 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b roc readlittle {
ab40: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 s} {..global spu
ab50: 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 rious done len..
ab60: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 set l [read $s 1
ab70: 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c ]..if {[string l
ab80: 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 ength $l] == 0}
ab90: 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 {.. if {![eof
aba0: 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 $s]} {...incr s
abb0: 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 purious.. } e
abc0: 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 lse {...close $s
abd0: 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 ...set done 1..
abe0: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 }..} else {..
abf0: 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 incr len [st
ac00: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
ac10: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
ac20: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
ac30: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
ac40: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
ac50: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
ac60: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
ac70: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
ac80: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
ac90: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
aca0: 65 61 64 61 62 6c 65 20 22 72 65 61 64 6c 69 74 eadable "readlit
acb0: 74 6c 65 20 24 63 22 0a 20 20 20 20 73 65 74 20 tle $c". set
acc0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
acd0: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
ace0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
acf0: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
ad00: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
ad10: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
ad20: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
ad30: 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _13_test_server}
ad40: 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 69 . list $spuri
ad50: 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 ous $len.} {0 26
ad60: 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 90}..test tlsIO-
ad70: 31 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 20 45 11.12 {testing E
ad80: 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b OF stickyness} {
ad90: 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 20 knownBug socket
ada0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
adb0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
adc0: 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 et counter 0.
add0: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
ade0: 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 proc count_up {s
adf0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e } {..global coun
ae00: 74 65 72 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 ter done after_i
ae10: 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 d..set l [gets $
ae20: 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d s]..if {[eof $s]
ae30: 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f } {.. incr co
ae40: 75 6e 74 65 72 0a 09 20 20 20 20 69 66 20 7b 24 unter.. if {$
ae50: 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 counter > 9} {..
ae60: 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 .set done {EOF i
ae70: 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 s sticky}...afte
ae80: 72 20 63 61 6e 63 65 6c 20 24 61 66 74 65 72 5f r cancel $after_
ae90: 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 id...close $s..
aea0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
aeb0: 20 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 proc timed_out
aec0: 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 {} {..global c
aed0: 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b done..set done {
aee0: 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 timed_out, EOF i
aef0: 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 s not sticky}..c
af00: 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 lose $c. }.
af10: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
af20: 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 et caCert $caCer
af30: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
af40: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 nd "set serverCe
af50: 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a rt $serverCert".
af60: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
af70: 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 "set clientCert
af80: 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 $clientCert".
af90: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
afa0: 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 t serverKey $ser
afb0: 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 verKey". send
afc0: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
afd0: 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 entKey $clientKe
afe0: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
aff0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
b000: 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 10_14_test_serve
b010: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
b020: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
b030: 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 rverCert \...-ca
b040: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
b050: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
b060: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
b070: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 accept 8836]..p
b080: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
b090: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
b0a0: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
b0b0: 20 61 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 after 100 close
b0c0: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
b0d0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
b0e0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
b0f0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
b100: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
b110: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
b120: 74 4b 65 79 20 5c 0a 20 20 20 20 09 24 72 65 6d tKey \. .$rem
b130: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
b140: 5d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 ]. fileevent
b150: 24 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 $c readable "cou
b160: 6e 74 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 nt_up $c". se
b170: 74 20 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 t after_id [afte
b180: 72 20 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 r 1000 timed_out
b190: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
b1a0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
b1b0: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
b1c0: 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 0_14_test_server
b1d0: 7d 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d }. set done.}
b1e0: 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d {EOF is sticky}
b1f0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
b200: 31 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 13 {testing asyn
b210: 63 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 c write, async f
b220: 6c 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 lush, async clos
b230: 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f e} \..{socket do
b240: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
b250: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f erver} {. pro
b260: 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 c readit {s} {..
b270: 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e global count don
b280: 65 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 e..set l [read $
b290: 73 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b s]..incr count [
b2a0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
b2b0: 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d ]..if {[eof $s]}
b2c0: 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 {.. close $s
b2d0: 0a 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 .. set done 1
b2e0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
b2f0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
b300: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
b310: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
b320: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
b330: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
b340: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
b350: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
b360: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
b370: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
b380: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
b390: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
b3a0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
b3b0: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
b3c0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
b3d0: 0a 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b ..set firstblock
b3e0: 20 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 ""..for {set i
b3f0: 30 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 0} {$i < 5} {inc
b400: 72 20 69 7d 20 7b 0a 09 09 73 65 74 20 66 69 72 r i} {...set fir
b410: 73 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 stblock "a$first
b420: 62 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b block$firstblock
b430: 22 0a 09 7d 0a 09 73 65 74 20 73 65 63 6f 6e 64 "..}..set second
b440: 62 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 block ""..for {s
b450: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 et i 0} {$i < 16
b460: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 } {incr i} {..
b470: 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 set secondbloc
b480: 6b 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b k "b$secondblock
b490: 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 09 7d $secondblock"..}
b4a0: 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f ..set l [tls::so
b4b0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
b4c0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c le $serverCert \
b4d0: 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 ...-cafile $caCe
b4e0: 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 rt \...-keyfile
b4f0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
b500: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
b510: 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 45]..proc accept
b520: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
b530: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
b540: 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 s.. fconfigur
b550: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
b560: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
b570: 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 -buffersize 163
b580: 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 84 \...-bufferin
b590: 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 g line.. file
b5a0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
b5b0: 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a e "readable $s".
b5c0: 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c .}..proc readabl
b5d0: 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 e {s} {.. set
b5e0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
b5f0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
b600: 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 eadable {}..
b610: 61 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f after 1000 respo
b620: 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 nd $s..}..proc r
b630: 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 espond {s} {..
b640: 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c global firstbl
b650: 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e ock.. puts -n
b660: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 onewline $s $fir
b670: 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 stblock.. aft
b680: 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 er 1000 writedat
b690: 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 a $s..}..proc wr
b6a0: 69 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 itedata {s} {..
b6b0: 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 global second
b6c0: 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 block.. puts
b6d0: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 -nonewline $s $s
b6e0: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 econdblock..
b6f0: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
b700: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
b710: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
b720: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
b730: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
b740: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
b750: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 clientKey \.
b760: 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 .$remoteServerIP
b770: 20 38 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e 66 8845]. fconf
b780: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
b790: 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d ng 0 -trans lf -
b7a0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
b7b0: 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 set count 0.
b7c0: 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f puts $s hello
b7d0: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b7e0: 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 s readable "read
b7f0: 69 74 20 24 73 22 0a 20 20 20 20 73 65 74 20 74 it $s". set t
b800: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
b810: 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 0 "set done time
b820: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
b830: 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 t done. after
b840: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
b850: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
b860: 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 close $l}. se
b870: 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a t count.} 65566.
b880: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 31 .test tlsIO-12.1
b890: 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 {testing inheri
b8a0: 74 61 6e 63 65 20 6f 66 20 73 65 72 76 65 72 20 tance of server
b8b0: 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 sockets} \..{soc
b8c0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
b8d0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
b8e0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
b8f0: 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 ript1. remove
b900: 46 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 File script2..
b910: 20 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a # Script1 is j
b920: 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 ust a 10 second
b930: 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 delay. If the s
b940: 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 erver socket.
b950: 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c # is inherited,
b960: 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 it will be held
b970: 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 open for 10 sec
b980: 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 onds.. set f
b990: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
b9a0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
b9b0: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
b9c0: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
b9d0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
b9e0: 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 $f.. # Script
b9f0: 32 20 63 72 65 61 74 65 73 20 74 68 65 20 73 65 2 creates the se
ba00: 72 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c 61 75 rver socket, lau
ba10: 6e 63 68 65 73 20 73 63 72 69 70 74 31 2c 0a 20 nches script1,.
ba20: 20 20 20 23 20 77 61 69 74 73 20 61 20 73 65 63 # waits a sec
ba30: 6f 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 2e 20 ond, and exits.
ba40: 20 54 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b The server sock
ba50: 65 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 20 et will now.
ba60: 23 20 62 65 20 63 6c 6f 73 65 64 20 75 6e 6c 65 # be closed unle
ba70: 73 73 20 73 63 72 69 70 74 31 20 69 6e 68 65 72 ss script1 inher
ba80: 69 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 73 65 ited it... se
ba90: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
baa0: 32 20 77 5d 0a 20 20 20 20 23 20 70 75 74 73 20 2 w]. # puts
bab0: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c $f [list set tcl
bac0: 74 65 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a test $::tcltest:
bad0: 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 :tcltest]. pu
bae0: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
baf0: 74 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 tclsh [info name
bb00: 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a 20 ofexecutable]].
bb10: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
bb20: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 63 ckage require tc
bb30: 6c 74 65 73 74 0a 09 70 61 63 6b 61 67 65 20 72 ltest..package r
bb40: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
bb50: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
bb60: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
bb70: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
bb80: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
bb90: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
bba0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
bbb0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 $serverKey 8828
bbc0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
bbd0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
bbe0: 20 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 20 file addr port
bbf0: 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 } {.. close $
bc00: 66 69 6c 65 0a 09 7d 0a 09 23 20 65 78 65 63 20 file..}..# exec
bc10: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
bc20: 65 73 74 20 73 63 72 69 70 74 31 20 26 0a 09 65 est script1 &..e
bc30: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
bc40: 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 t1 &..close $f..
bc50: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
bc60: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
bc70: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
bc80: 66 0a 09 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 f... # Launch
bc90: 20 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 69 script2 and wai
bca0: 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 t 5 seconds..
bcb0: 20 23 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 # exec $::tclte
bcc0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
bcd0: 70 74 32 20 26 0a 20 20 20 20 65 78 65 63 20 5b pt2 &. exec [
bce0: 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 info nameofexecu
bcf0: 74 61 62 6c 65 5d 20 73 63 72 69 70 74 32 20 26 table] script2 &
bd00: 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 . after 5000
bd10: 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 { set ok_to_proc
bd20: 65 65 64 20 31 20 7d 0a 20 20 20 20 76 77 61 69 eed 1 }. vwai
bd30: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a t ok_to_proceed.
bd40: 0a 20 20 20 20 23 20 49 66 20 77 65 20 63 61 6e . # If we can
bd50: 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 still connect t
bd60: 6f 20 74 68 65 20 73 65 72 76 65 72 2c 20 74 68 o the server, th
bd70: 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68 e socket got inh
bd80: 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 20 erited... if
bd90: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
bda0: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
bdb0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
bdc0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
bdd0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
bde0: 79 20 5c 0a 20 20 20 09 20 31 32 37 2e 30 2e 30 y \. . 127.0.0
bdf0: 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b .1 8828} msg]} {
be00: 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 ..set x {server
be10: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
be20: 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 20 nherited}. }
be30: 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d else {..close $m
be40: 73 67 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 sg..set x {serve
be50: 72 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 r socket was inh
be60: 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 erited}. }..
be70: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
be80: 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 ript1. remove
be90: 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 File script2.
bea0: 20 73 65 74 20 78 0a 7d 20 7b 73 65 72 76 65 72 set x.} {server
beb0: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
bec0: 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 inherited}..test
bed0: 20 74 6c 73 49 4f 2d 31 32 2e 32 20 7b 74 65 73 tlsIO-12.2 {tes
bee0: 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 ting inheritance
bef0: 20 6f 66 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 of client socke
bf00: 74 73 7d 20 5c 0a 09 7b 75 6e 65 78 70 6c 61 69 ts} \..{unexplai
bf10: 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 nedFailure socke
bf20: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
bf30: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
bf40: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
bf50: 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 pt1. removeFi
bf60: 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 le script2..
bf70: 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 # Script1 is jus
bf80: 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 t a 10 second de
bf90: 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 lay. If the ser
bfa0: 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 ver socket. #
bfb0: 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 is inherited, i
bfc0: 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f t will be held o
bfd0: 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e pen for 10 secon
bfe0: 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ds.. set f [o
bff0: 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 pen script1 w].
c000: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 puts $f {..af
c010: 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 ter 10000 exit..
c020: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
c030: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
c040: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 .. # Script2
c050: 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 opens the client
c060: 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 socket and writ
c070: 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 es to it. It th
c080: 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 en. # launche
c090: 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 s script1 and ex
c0a0: 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 its. If the chi
c0b0: 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 ld process inher
c0c0: 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 ited the. # c
c0d0: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 lient socket, th
c0e0: 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 e socket will st
c0f0: 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 ill be open...
c100: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
c110: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 ript2 w]. put
c120: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 s $f [list set t
c130: 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f clsh [info nameo
c140: 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a 20 20 fexecutable]].
c150: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
c160: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
c170: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
c180: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
c190: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
c1a0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
c1b0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
c1c0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
c1d0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
c1e0: 38 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 74 8829 \]". put
c1f0: 73 20 24 66 20 7b 0a 09 65 78 65 63 20 24 74 63 s $f {..exec $tc
c200: 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 70 lsh script1 &..p
c210: 75 74 73 20 24 66 20 74 65 73 74 69 6e 67 0a 09 uts $f testing..
c220: 66 6c 75 73 68 20 24 66 0a 09 61 66 74 65 72 20 flush $f..after
c230: 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 1000 exit..vwait
c240: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
c250: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
c260: 20 23 20 43 72 65 61 74 65 20 74 68 65 20 73 65 # Create the se
c270: 72 76 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 20 rver socket..
c280: 20 73 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 set server [tls
c290: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
c2a0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
c2b0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
c2c0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
c2d0: 65 72 4b 65 79 20 5c 0a 09 2d 73 65 72 76 65 72 erKey \..-server
c2e0: 20 61 63 63 65 70 74 20 38 38 32 39 5d 0a 20 20 accept 8829].
c2f0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 proc accept {
c300: 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d file host port }
c310: 20 7b 0a 0a 09 23 20 57 68 65 6e 20 74 68 65 20 {...# When the
c320: 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 2c client connects,
c330: 20 65 73 74 61 62 6c 69 73 68 20 74 68 65 20 72 establish the r
c340: 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c 6f ead handler..glo
c350: 62 61 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f 73 bal server..clos
c360: 65 20 24 73 65 72 76 65 72 0a 09 66 69 6c 65 65 e $server..filee
c370: 76 65 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 vent $file reada
c380: 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 ble [list getdat
c390: 61 20 24 66 69 6c 65 5d 0a 09 66 63 6f 6e 66 69 a $file]..fconfi
c3a0: 67 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 66 gure $file -buff
c3b0: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 62 6c 6f 63 ering line -bloc
c3c0: 6b 69 6e 67 20 30 0a 09 72 65 74 75 72 6e 0a 20 king 0..return.
c3d0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 67 65 }. proc ge
c3e0: 74 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b tdata { file } {
c3f0: 0a 0a 09 23 20 52 65 61 64 20 68 61 6e 64 6c 65 ...# Read handle
c400: 72 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 65 r on the accepte
c410: 64 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 d socket...globa
c420: 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c l x..global fail
c430: 65 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b ed..set status [
c440: 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c catch {read $fil
c450: 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 e} data]..if {$s
c460: 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 tatus != 0} {..
c470: 20 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 66 set x {read f
c480: 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 ailed, error was
c490: 20 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 74 $data}.. cat
c4a0: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
c4b0: 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 }..} elseif {[s
c4c0: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d tring compare {}
c4d0: 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c $data]} {..} el
c4e0: 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 seif {[fblocked
c4f0: 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 $file]} {..} els
c500: 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d eif {[eof $file]
c510: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 } {.. if {$fa
c520: 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 iled} {...set x
c530: 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 {client socket w
c540: 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 as inherited}..
c550: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 } else {...se
c560: 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b t x {client sock
c570: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
c580: 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 ited}.. }..
c590: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
c5a0: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 $file }..} else
c5b0: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 6d {.. set x {im
c5c0: 70 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 possible case}..
c5d0: 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 catch { clos
c5e0: 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 e $file }..}..re
c5f0: 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 turn. }..
c600: 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 # If the socket
c610: 64 6f 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d doesn't hit end-
c620: 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 of-file in 5 sec
c630: 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 onds, the. #
c640: 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 script1 process
c650: 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 must have inheri
c660: 74 65 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a ted the client..
c670: 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 . set failed
c680: 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 0. after 5000
c690: 20 5b 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 [list set faile
c6a0: 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e d 1].. # Laun
c6b0: 63 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 ch the script2 p
c6c0: 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 rocess.. exec
c6d0: 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 [info nameofexe
c6e0: 63 75 74 61 62 6c 65 5d 20 73 63 72 69 70 74 32 cutable] script2
c6f0: 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a &.. vwait x.
c700: 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 if {!$failed
c710: 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 } {..vwait faile
c720: 64 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 6d 6f d. }. remo
c730: 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 veFile script1.
c740: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
c750: 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a ript2. set x.
c760: 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 } {client socket
c770: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
c780: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
c790: 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.3 {testing in
c7a0: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 heritance of acc
c7b0: 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c epted sockets} \
c7c0: 0a 09 7b 68 61 6e 67 73 4f 6e 4c 69 6e 75 78 20 ..{hangsOnLinux
c7d0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
c7e0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
c7f0: 7b 0a 20 20 20 20 23 20 68 61 6e 67 73 20 6f 6e {. # hangs on
c800: 20 4c 69 6e 75 78 0a 20 20 20 20 72 65 6d 6f 76 Linux. remov
c810: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
c820: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
c830: 69 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 ipt2.. set f
c840: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
c850: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
c860: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
c870: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
c880: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
c890: 24 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f.. set f [o
c8a0: 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 pen script2 w].
c8b0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
c8c0: 20 73 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 6f set tclsh [info
c8d0: 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c nameofexecutabl
c8e0: 65 5d 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 e]]. puts $f
c8f0: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
c900: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
c910: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 63 61 . puts $f "ca
c920: 74 63 68 20 7b 73 65 74 20 66 20 5c 5b 74 6c 73 tch {set f \[tls
c930: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
c940: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
c950: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
c960: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
c970: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
c980: 79 20 38 39 33 30 20 5c 5d 7d 22 0a 20 20 20 20 y 8930 \]}".
c990: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
c9a0: 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f accept { file ho
c9b0: 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 st port } {..
c9c0: 20 67 6c 6f 62 61 6c 20 74 63 6c 73 68 0a 09 20 global tclsh..
c9d0: 20 20 20 70 75 74 73 20 24 66 69 6c 65 20 7b 74 puts $file {t
c9e0: 65 73 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 6b est data on sock
c9f0: 65 74 7d 0a 09 20 20 20 20 65 78 65 63 20 24 74 et}.. exec $t
ca00: 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 clsh script1 &..
ca10: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 65 after 1000 e
ca20: 78 69 74 0a 09 7d 0a 09 63 61 74 63 68 20 7b 76 xit..}..catch {v
ca30: 77 61 69 74 20 66 6f 72 65 76 65 72 7d 0a 20 20 wait forever}.
ca40: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
ca50: 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 .. # Launch t
ca60: 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 he script2 proce
ca70: 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 ss and connect t
ca80: 6f 20 69 74 2e 20 20 53 65 65 20 68 6f 77 20 6c o it. See how l
ca90: 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 20 73 6f ong. # the so
caa0: 63 6b 65 74 20 73 74 61 79 73 20 6f 70 65 6e 0a cket stays open.
cab0: 0a 20 20 20 20 65 78 65 63 20 5b 69 6e 66 6f 20 . exec [info
cac0: 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 nameofexecutable
cad0: 5d 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 ] script2 &..
cae0: 20 61 66 74 65 72 20 31 30 30 30 20 73 65 74 20 after 1000 set
caf0: 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a ok_to_proceed 1.
cb00: 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f vwait ok_to_
cb10: 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 73 65 74 proceed.. set
cb20: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
cb30: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
cb40: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
cb50: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
cb60: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
cb70: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
cb80: 31 20 38 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 1 8930]. fcon
cb90: 66 69 67 75 72 65 20 24 66 20 2d 62 75 66 66 65 figure $f -buffe
cba0: 72 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b ring full -block
cbb0: 69 6e 67 20 30 0a 20 20 20 20 66 69 6c 65 65 76 ing 0. fileev
cbc0: 65 6e 74 20 24 66 20 72 65 61 64 61 62 6c 65 20 ent $f readable
cbd0: 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 24 66 [list getdata $f
cbe0: 5d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 ].. # If the
cbf0: 73 6f 63 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 socket is still
cc00: 6f 70 65 6e 20 61 66 74 65 72 20 35 20 73 65 63 open after 5 sec
cc10: 6f 6e 64 73 2c 20 74 68 65 20 73 63 72 69 70 74 onds, the script
cc20: 31 20 70 72 6f 63 65 73 73 0a 20 20 20 20 23 20 1 process. #
cc30: 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 must have inheri
cc40: 74 65 64 20 74 68 65 20 61 63 63 65 70 74 65 64 ted the accepted
cc50: 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 socket... se
cc60: 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 t failed 0. a
cc70: 66 74 65 72 20 35 30 30 30 20 73 65 74 20 66 61 fter 5000 set fa
cc80: 69 6c 65 64 20 31 0a 0a 20 20 20 20 70 72 6f 63 iled 1.. proc
cc90: 20 67 65 74 64 61 74 61 20 7b 20 66 69 6c 65 20 getdata { file
cca0: 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 61 6e } {...# Read han
ccb0: 64 6c 65 72 20 6f 6e 20 74 68 65 20 63 6c 69 65 dler on the clie
ccc0: 6e 74 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 nt socket...glob
ccd0: 61 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 al x..global fai
cce0: 6c 65 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 led..set status
ccf0: 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 [catch {read $fi
cd00: 6c 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 le} data]..if {$
cd10: 73 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 status != 0} {..
cd20: 20 20 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 set x {read
cd30: 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 failed, error wa
cd40: 73 20 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 s $data}.. ca
cd50: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
cd60: 65 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b e }..} elseif {[
cd70: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b string compare {
cd80: 7d 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 } $data]} {..} e
cd90: 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 lseif {[fblocked
cda0: 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c $file]} {..} el
cdb0: 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 seif {[eof $file
cdc0: 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 ]} {.. if {$f
cdd0: 61 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 ailed} {...set x
cde0: 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 {accepted socke
cdf0: 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d t was inherited}
ce00: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
ce10: 09 73 65 74 20 78 20 7b 61 63 63 65 70 74 65 64 .set x {accepted
ce20: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
ce30: 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 inherited}..
ce40: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
ce50: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 lose $file }..}
ce60: 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 else {.. set
ce70: 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 x {impossible ca
ce80: 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b se}.. catch {
ce90: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
cea0: 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a }..return. }.
ceb0: 20 20 20 20 0a 20 20 20 20 76 77 61 69 74 20 78 . vwait x
cec0: 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 .. removeFile
ced0: 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d script1. rem
cee0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a oveFile script2.
cef0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 set x.} {acc
cf00: 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 epted socket was
cf10: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
cf20: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e 31 .test tlsIO-13.1
cf30: 20 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 {Testing use of
cf40: 20 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 shared socket b
cf50: 65 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 etween two threa
cf60: 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 ds} \..{socket t
cf70: 65 73 74 74 68 72 65 61 64 7d 20 7b 0a 0a 20 20 estthread} {..
cf80: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
cf90: 69 70 74 0a 20 20 20 20 74 68 72 65 61 64 52 65 ipt. threadRe
cfa0: 61 70 0a 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 ap.. makeFile
cfb0: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
cfc0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
cfd0: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
cfe0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
cff0: 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 828]..proc accep
d000: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 t {s a p} {.
d010: 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e fileeven
d020: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
d030: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
d040: 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 fconfig
d050: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
d060: 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d g line. }
d070: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
d080: 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 {.. global i
d090: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 . se
d0a0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
d0b0: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
d0c0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
d0d0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
d0e0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
d0f0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
d100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d110: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
d120: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
d130: 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 .. incr
d140: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
d150: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
d160: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
d170: 0a 09 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 ..set i 0..vwait
d180: 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 x..close $f...#
d190: 20 74 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 thread cleans i
d1a0: 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 tself up...testt
d1b0: 68 72 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d hread exit. }
d1c0: 20 73 63 72 69 70 74 0a 20 20 20 20 0a 20 20 20 script. .
d1d0: 20 23 20 63 72 65 61 74 65 20 61 20 74 68 72 65 # create a thre
d1e0: 61 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 ad. set serve
d1f0: 72 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 rthread [testthr
d200: 65 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 ead create { sou
d210: 72 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 rce script } ].
d220: 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 0a 20 update. .
d230: 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 after 1000.
d240: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
d250: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 cket 127.0.0.1 8
d260: 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 828]. fconfig
d270: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
d280: 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 g line.. catc
d290: 68 20 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 h {..puts $s "he
d2a0: 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 llo"..gets $s re
d2b0: 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 sult. }. c
d2c0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 lose $s. upda
d2d0: 74 65 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 te.. after 20
d2e0: 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 00. lappend r
d2f0: 65 73 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 esult [threadRea
d300: 70 5d 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 p]. . set
d310: 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f result..} {hello
d320: 20 31 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 1}..# cleanup.i
d330: 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 f {[string match
d340: 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 sock* $commandS
d350: 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 ocket] == 1} {.
d360: 20 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 puts $commandS
d370: 6f 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 6c ocket exit. fl
d380: 75 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ush $commandSock
d390: 65 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 et.}.catch {clos
d3a0: 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 e $commandSocket
d3b0: 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 }.catch {close $
d3c0: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a remoteProcChan}.
d3d0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e ::tcltest::clean
d3e0: 75 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 74 upTests.flush st
d3f0: 64 6f 75 74 0a 72 65 74 75 72 6e 0a 0a dout.return..