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 6f 2e 74 65 73 74 2c 76 20 31 : tlsIo.test,v 1
0200: 2e 31 33 20 32 30 30 30 2f 30 36 2f 30 35 20 32 .13 2000/06/05 2
0210: 30 3a 32 32 3a 33 34 20 61 62 6f 72 72 20 45 78 0:22:34 aborr Ex
0220: 70 20 24 0a 0a 23 20 52 75 6e 6e 69 6e 67 20 73 p $..# Running s
0230: 6f 63 6b 65 74 20 74 65 73 74 73 20 77 69 74 68 ocket tests with
0240: 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 a remote server
0250: 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d :.# ------------
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 0a 23 --------------.#
0280: 20 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 69 .# Some tests i
0290: 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 64 65 n socket.test de
02a0: 70 65 6e 64 20 6f 6e 20 74 68 65 20 65 78 69 73 pend on the exis
02b0: 74 65 6e 63 65 20 6f 66 20 61 20 72 65 6d 6f 74 tence of a remot
02c0: 65 20 73 65 72 76 65 72 20 74 6f 0a 23 20 77 68 e server to.# wh
02d0: 69 63 68 20 74 68 65 79 20 63 6f 6e 6e 65 63 74 ich they connect
02e0: 2e 20 54 68 65 20 72 65 6d 6f 74 65 20 73 65 72 . The remote ser
02f0: 76 65 72 20 6d 75 73 74 20 62 65 20 61 6e 20 69 ver must be an i
0300: 6e 73 74 61 6e 63 65 20 6f 66 20 74 63 6c 74 65 nstance of tclte
0310: 73 74 20 61 6e 64 20 69 74 0a 23 20 6d 75 73 74 st and it.# must
0320: 20 72 75 6e 20 74 68 65 20 73 63 72 69 70 74 20 run the script
0330: 66 6f 75 6e 64 20 69 6e 20 74 68 65 20 66 69 6c found in the fil
0340: 65 20 22 72 65 6d 6f 74 65 2e 74 63 6c 22 20 69 e "remote.tcl" i
0350: 6e 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 n this directory
0360: 2e 20 59 6f 75 0a 23 20 63 61 6e 20 73 74 61 72 . You.# can star
0370: 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 t the remote ser
0380: 76 65 72 20 6f 6e 20 61 6e 79 20 6d 61 63 68 69 ver on any machi
0390: 6e 65 20 72 65 61 63 68 61 62 6c 65 20 66 72 6f ne reachable fro
03a0: 6d 20 74 68 65 20 6d 61 63 68 69 6e 65 20 6f 6e m the machine on
03b0: 0a 23 20 77 68 69 63 68 20 79 6f 75 20 77 61 6e .# which you wan
03c0: 74 20 74 6f 20 72 75 6e 20 74 68 65 20 73 6f 63 t to run the soc
03d0: 6b 65 74 20 74 65 73 74 73 2c 20 62 79 20 69 73 ket tests, by is
03e0: 73 75 69 6e 67 3a 0a 23 20 0a 23 20 20 20 20 20 suing:.# .#
03f0: 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 tcltest remote.t
0400: 63 6c 20 2d 70 6f 72 74 20 32 30 34 38 09 23 20 cl -port 2048.#
0410: 4f 72 20 63 68 6f 6f 73 65 20 61 6e 6f 74 68 65 Or choose anothe
0420: 72 20 70 6f 72 74 20 6e 75 6d 62 65 72 2e 0a 23 r port number..#
0430: 20 0a 23 20 49 66 20 74 68 65 20 6d 61 63 68 69 .# If the machi
0440: 6e 65 20 79 6f 75 20 61 72 65 20 72 75 6e 6e 69 ne you are runni
0450: 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 ng the remote se
0460: 72 76 65 72 20 6f 6e 20 68 61 73 20 73 65 76 65 rver on has seve
0470: 72 61 6c 20 49 50 0a 23 20 69 6e 74 65 72 66 61 ral IP.# interfa
0480: 63 65 73 2c 20 79 6f 75 20 63 61 6e 20 63 68 6f ces, you can cho
0490: 6f 73 65 20 77 68 69 63 68 20 69 6e 74 65 72 66 ose which interf
04a0: 61 63 65 20 74 68 65 20 73 65 72 76 65 72 20 6c ace the server l
04b0: 69 73 74 65 6e 73 20 6f 6e 20 66 6f 72 0a 23 20 istens on for.#
04c0: 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 62 79 20 73 connections by s
04d0: 70 65 63 69 66 79 69 6e 67 20 74 68 65 20 2d 61 pecifying the -a
04e0: 64 64 72 65 73 73 20 63 6f 6d 6d 61 6e 64 20 6c ddress command l
04f0: 69 6e 65 20 66 6c 61 67 2c 20 73 6f 3a 0a 23 20 ine flag, so:.#
0500: 0a 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 .# tcltest r
0510: 65 6d 6f 74 65 2e 74 63 6c 20 2d 61 64 64 72 65 emote.tcl -addre
0520: 73 73 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e ss your.machine.
0530: 63 6f 6d 0a 23 20 0a 23 20 54 68 65 73 65 20 6f com.# .# These o
0540: 70 74 69 6f 6e 73 20 63 61 6e 20 61 6c 73 6f 20 ptions can also
0550: 62 65 20 73 65 74 20 62 79 20 65 6e 76 69 72 6f be set by enviro
0560: 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 2e nment variables.
0570: 20 4f 6e 20 55 6e 69 78 2c 20 79 6f 75 20 63 61 On Unix, you ca
0580: 6e 0a 23 20 74 79 70 65 20 74 68 65 73 65 20 63 n.# type these c
0590: 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 73 ommands to the s
05a0: 68 65 6c 6c 20 66 72 6f 6d 20 77 68 69 63 68 20 hell from which
05b0: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
05c0: 72 20 69 73 20 73 74 61 72 74 65 64 3a 0a 23 20 r is started:.#
05d0: 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 .# shell% se
05e0: 74 65 6e 76 20 73 65 72 76 65 72 50 6f 72 74 20 tenv serverPort
05f0: 32 30 34 38 0a 23 20 20 20 20 20 73 68 65 6c 6c 2048.# shell
0600: 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 41 % setenv serverA
0610: 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 ddress your.mach
0620: 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 61 6e 64 ine.com.# .# and
0630: 20 73 75 62 73 65 71 75 65 6e 74 6c 79 20 79 6f subsequently yo
0640: 75 20 63 61 6e 20 73 74 61 72 74 20 74 68 65 20 u can start the
0650: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 77 69 remote server wi
0660: 74 68 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c th:.# .# tcl
0670: 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 0a test remote.tcl.
0680: 23 20 0a 23 20 74 6f 20 68 61 76 65 20 69 74 20 # .# to have it
0690: 6c 69 73 74 65 6e 20 6f 6e 20 70 6f 72 74 20 32 listen on port 2
06a0: 30 34 38 20 6f 6e 20 74 68 65 20 69 6e 74 65 72 048 on the inter
06b0: 66 61 63 65 20 79 6f 75 72 2e 6d 61 63 68 69 6e face your.machin
06c0: 65 2e 63 6f 6d 2e 0a 23 20 20 20 20 20 0a 23 20 e.com..# .#
06d0: 57 68 65 6e 20 74 68 65 20 73 65 72 76 65 72 20 When the server
06e0: 73 74 61 72 74 73 2c 20 69 74 20 70 72 69 6e 74 starts, it print
06f0: 73 20 6f 75 74 20 61 20 64 65 74 61 69 6c 65 64 s out a detailed
0700: 20 6d 65 73 73 61 67 65 20 63 6f 6e 74 61 69 6e message contain
0710: 69 6e 67 20 69 74 73 0a 23 20 63 6f 6e 66 69 67 ing its.# config
0720: 75 72 61 74 69 6f 6e 20 69 6e 66 6f 72 6d 61 74 uration informat
0730: 69 6f 6e 2c 20 61 6e 64 20 69 74 20 77 69 6c 6c ion, and it will
0740: 20 62 6c 6f 63 6b 20 75 6e 74 69 6c 20 6b 69 6c block until kil
0750: 6c 65 64 20 77 69 74 68 20 61 20 43 74 72 6c 2d led with a Ctrl-
0760: 43 2e 0a 23 20 4f 6e 63 65 20 74 68 65 20 72 65 C..# Once the re
0770: 6d 6f 74 65 20 73 65 72 76 65 72 20 65 78 69 73 mote server exis
0780: 74 73 2c 20 79 6f 75 20 63 61 6e 20 72 75 6e 20 ts, you can run
0790: 74 68 65 20 74 65 73 74 73 20 69 6e 20 73 6f 63 the tests in soc
07a0: 6b 65 74 2e 74 65 73 74 20 77 69 74 68 0a 23 20 ket.test with.#
07b0: 74 68 65 20 73 65 72 76 65 72 20 62 79 20 73 65 the server by se
07c0: 74 74 69 6e 67 20 74 77 6f 20 54 63 6c 20 76 61 tting two Tcl va
07d0: 72 69 61 62 6c 65 73 3a 0a 23 20 0a 23 20 20 20 riables:.# .#
07e0: 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 65 % set remoteSe
07f0: 72 76 65 72 49 50 20 3c 6e 61 6d 65 20 6f 72 20 rverIP <name or
0800: 61 64 64 72 65 73 73 20 6f 66 20 6d 61 63 68 69 address of machi
0810: 6e 65 20 6f 6e 20 77 68 69 63 68 20 73 65 72 76 ne on which serv
0820: 65 72 20 72 75 6e 73 3e 0a 23 20 20 20 20 20 25 er runs>.# %
0830: 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 set remoteServe
0840: 72 50 6f 72 74 20 32 30 34 38 0a 23 20 0a 23 20 rPort 2048.# .#
0850: 54 68 65 73 65 20 76 61 72 69 61 62 6c 65 73 20 These variables
0860: 61 72 65 20 61 6c 73 6f 20 73 65 74 74 61 62 6c are also settabl
0870: 65 20 66 72 6f 6d 20 74 68 65 20 65 6e 76 69 72 e from the envir
0880: 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 55 6e 69 78 2c onment. On Unix,
0890: 20 79 6f 75 20 63 61 6e 3a 0a 23 20 0a 23 20 20 you can:.# .#
08a0: 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 shell% setenv
08b0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
08c0: 6d 61 63 68 69 6e 65 2e 77 68 65 72 65 2e 73 65 machine.where.se
08d0: 72 76 65 72 2e 72 75 6e 73 0a 23 20 20 20 20 20 rver.runs.#
08e0: 73 68 65 6c 6c 25 20 73 65 6e 65 74 76 20 72 65 shell% senetv re
08f0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 32 moteServerPort 2
0900: 30 34 38 0a 23 20 0a 23 20 54 68 65 20 70 72 65 048.# .# The pre
0910: 61 6d 62 6c 65 20 6f 66 20 74 68 65 20 73 6f 63 amble of the soc
0920: 6b 65 74 2e 74 65 73 74 20 66 69 6c 65 20 63 68 ket.test file ch
0930: 65 63 6b 73 20 74 6f 20 73 65 65 20 69 66 20 74 ecks to see if t
0940: 68 65 20 76 61 72 69 61 62 6c 65 73 20 61 72 65 he variables are
0950: 20 73 65 74 0a 23 20 65 69 74 68 65 72 20 69 6e set.# either in
0960: 20 54 63 6c 20 6f 72 20 69 6e 20 74 68 65 20 65 Tcl or in the e
0970: 6e 76 69 72 6f 6e 6d 65 6e 74 3b 20 69 66 20 74 nvironment; if t
0980: 68 65 79 20 61 72 65 2c 20 69 74 20 61 74 74 65 hey are, it atte
0990: 6d 70 74 73 20 74 6f 20 63 6f 6e 6e 65 63 74 20 mpts to connect
09a0: 74 6f 0a 23 20 74 68 65 20 73 65 72 76 65 72 2e to.# the server.
09b0: 20 49 66 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 If the connecti
09c0: 6f 6e 20 69 73 20 73 75 63 63 65 73 73 66 75 6c on is successful
09d0: 2c 20 74 68 65 20 74 65 73 74 73 20 75 73 69 6e , the tests usin
09e0: 67 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 g the remote.# s
09f0: 65 72 76 65 72 20 77 69 6c 6c 20 62 65 20 70 65 erver will be pe
0a00: 72 66 6f 72 6d 65 64 3b 20 6f 74 68 65 72 77 69 rformed; otherwi
0a10: 73 65 2c 20 69 74 20 77 69 6c 6c 20 61 74 74 65 se, it will atte
0a20: 6d 70 74 20 74 6f 20 73 74 61 72 74 20 74 68 65 mpt to start the
0a30: 20 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 remote.# server
0a40: 20 28 76 69 61 20 65 78 65 63 29 20 6f 6e 20 70 (via exec) on p
0a50: 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 73 75 latforms that su
0a60: 70 70 6f 72 74 20 74 68 69 73 2c 20 6f 6e 20 74 pport this, on t
0a70: 68 65 20 6c 6f 63 61 6c 20 68 6f 73 74 2c 0a 23 he local host,.#
0a80: 20 6c 69 73 74 65 6e 69 6e 67 20 61 74 20 70 6f listening at po
0a90: 72 74 20 32 30 34 38 2e 20 49 66 20 61 6c 6c 20 rt 2048. If all
0aa0: 66 61 69 6c 73 2c 20 61 20 6d 65 73 73 61 67 65 fails, a message
0ab0: 20 69 73 20 70 72 69 6e 74 65 64 20 61 6e 64 20 is printed and
0ac0: 74 68 65 20 74 65 73 74 73 0a 23 20 75 73 69 6e the tests.# usin
0ad0: 67 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 g the remote ser
0ae0: 76 65 72 20 61 72 65 20 6e 6f 74 20 70 65 72 66 ver are not perf
0af0: 6f 72 6d 65 64 2e 0a 0a 69 66 20 7b 5b 6c 73 65 ormed...if {[lse
0b00: 61 72 63 68 20 5b 6e 61 6d 65 73 70 61 63 65 20 arch [namespace
0b10: 63 68 69 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c 74 children] ::tclt
0b20: 65 73 74 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 20 est] == -1} {.
0b30: 20 20 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 package requir
0b40: 65 20 74 63 6c 74 65 73 74 0a 20 20 20 20 6e 61 e tcltest. na
0b50: 6d 65 73 70 61 63 65 20 69 6d 70 6f 72 74 20 2d mespace import -
0b60: 66 6f 72 63 65 20 3a 3a 74 63 6c 74 65 73 74 3a force ::tcltest:
0b70: 3a 2a 0a 7d 0a 0a 23 20 4c 6f 61 64 20 74 68 65 :*.}..# Load the
0b80: 20 74 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 63 tls package.pac
0b90: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
0ba0: 0a 0a 73 65 74 20 73 65 72 76 65 72 43 65 72 74 ..set serverCert
0bb0: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 [file join $::t
0bc0: 63 6c 74 65 73 74 3a 3a 74 65 73 74 73 44 69 72 cltest::testsDir
0bd0: 65 63 74 6f 72 79 20 63 65 72 74 73 20 73 65 72 ectory certs ser
0be0: 76 65 72 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 ver.pem].set cli
0bf0: 65 6e 74 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f entCert [file jo
0c00: 69 6e 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 in $::tcltest::t
0c10: 65 73 74 73 44 69 72 65 63 74 6f 72 79 20 63 65 estsDirectory ce
0c20: 72 74 73 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a rts client.pem].
0c30: 73 65 74 20 63 61 43 65 72 74 20 5b 66 69 6c 65 set caCert [file
0c40: 20 6a 6f 69 6e 20 24 3a 3a 74 63 6c 74 65 73 74 join $::tcltest
0c50: 3a 3a 74 65 73 74 73 44 69 72 65 63 74 6f 72 79 ::testsDirectory
0c60: 20 63 65 72 74 73 20 63 61 63 65 72 74 2e 70 65 certs cacert.pe
0c70: 6d 5d 0a 73 65 74 20 73 65 72 76 65 72 4b 65 79 m].set serverKey
0c80: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 [file join $::t
0c90: 63 6c 74 65 73 74 3a 3a 74 65 73 74 73 44 69 72 cltest::testsDir
0ca0: 65 63 74 6f 72 79 20 63 65 72 74 73 20 73 6b 65 ectory certs ske
0cb0: 79 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e y.pem].set clien
0cc0: 74 4b 65 79 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 tKey [file join
0cd0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 $::tcltest::test
0ce0: 73 44 69 72 65 63 74 6f 72 79 20 63 65 72 74 73 sDirectory certs
0cf0: 20 63 6b 65 79 2e 70 65 6d 5d 0a 0a 23 20 53 6f ckey.pem]..# So
0d00: 6d 65 20 74 65 73 74 73 20 72 65 71 75 69 72 65 me tests require
0d10: 20 74 68 65 20 74 65 73 74 74 68 72 65 61 64 20 the testthread
0d20: 63 6f 6d 6d 61 6e 64 0a 0a 73 65 74 20 3a 3a 74 command..set ::t
0d30: 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 cltest::testCons
0d40: 74 72 61 69 6e 74 73 28 74 65 73 74 74 68 72 65 traints(testthre
0d50: 61 64 29 20 5c 0a 09 5b 65 78 70 72 20 7b 5b 69 ad) \..[expr {[i
0d60: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 74 65 73 nfo commands tes
0d70: 74 74 68 72 65 61 64 5d 20 21 3d 20 7b 7d 7d 5d tthread] != {}}]
0d80: 0a 0a 23 0a 23 20 49 66 20 72 65 6d 6f 74 65 53 ..#.# If remoteS
0d90: 65 72 76 65 72 49 50 20 6f 72 20 72 65 6d 6f 74 erverIP or remot
0da0: 65 53 65 72 76 65 72 50 6f 72 74 20 61 72 65 20 eServerPort are
0db0: 6e 6f 74 20 73 65 74 2c 20 63 68 65 63 6b 20 69 not set, check i
0dc0: 6e 20 74 68 65 0a 23 20 65 6e 76 69 72 6f 6e 6d n the.# environm
0dd0: 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 66 6f ent variables fo
0de0: 72 20 65 78 74 65 72 6e 61 6c 6c 79 20 73 65 74 r externally set
0df0: 20 76 61 6c 75 65 73 2e 0a 23 0a 0a 69 66 20 7b values..#..if {
0e00: 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 ![info exists re
0e10: 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b moteServerIP]} {
0e20: 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 . if {[info e
0e30: 78 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 xists env(remote
0e40: 53 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 ServerIP)]} {..s
0e50: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 et remoteServerI
0e60: 50 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 P $env(remoteSer
0e70: 76 65 72 49 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 verIP). }.}.i
0e80: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
0e90: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 remoteServerPor
0ea0: 74 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 t]} {. if {[i
0eb0: 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 nfo exists env(r
0ec0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 5d 7d emoteServerIP)]}
0ed0: 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 {..set remoteSe
0ee0: 72 76 65 72 50 6f 72 74 20 24 65 6e 76 28 72 65 rverPort $env(re
0ef0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 0a moteServerPort).
0f00: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
0f10: 20 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 if {[info e
0f20: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
0f30: 65 72 49 50 5d 7d 20 7b 0a 09 20 20 20 20 73 65 erIP]} {.. se
0f40: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
0f50: 72 74 20 32 30 34 38 0a 20 20 20 20 20 20 20 20 rt 2048.
0f60: 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 }. }.}..#.# C
0f70: 68 65 63 6b 20 69 66 20 77 65 27 72 65 20 73 75 heck if we're su
0f80: 70 70 6f 73 65 64 20 74 6f 20 64 6f 20 74 65 73 pposed to do tes
0f90: 74 73 20 61 67 61 69 6e 73 74 20 74 68 65 20 72 ts against the r
0fa0: 65 6d 6f 74 65 20 73 65 72 76 65 72 0a 23 0a 0a emote server.#..
0fb0: 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 set doTestsWithR
0fc0: 65 6d 6f 74 65 53 65 72 76 65 72 20 31 0a 69 66 emoteServer 1.if
0fd0: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
0fe0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 20 remoteServerIP]
0ff0: 26 26 20 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 && ($tcl_platfor
1000: 6d 28 70 6c 61 74 66 6f 72 6d 29 20 21 3d 20 22 m(platform) != "
1010: 6d 61 63 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 macintosh")} {.
1020: 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 set remoteSer
1030: 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a verIP 127.0.0.1.
1040: 7d 0a 69 66 20 7b 28 24 64 6f 54 65 73 74 73 57 }.if {($doTestsW
1050: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
1060: 3d 3d 20 31 29 20 26 26 20 28 21 5b 69 6e 66 6f == 1) && (![info
1070: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 exists remoteSe
1080: 72 76 65 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 rverPort])} {.
1090: 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 set remoteServ
10a0: 65 72 50 6f 72 74 20 32 30 34 38 0a 7d 0a 0a 23 erPort 2048.}..#
10b0: 20 41 74 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e Attempt to conn
10c0: 65 63 74 20 74 6f 20 61 20 72 65 6d 6f 74 65 20 ect to a remote
10d0: 73 65 72 76 65 72 20 69 66 20 6f 6e 65 20 69 73 server if one is
10e0: 20 61 6c 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 already running
10f0: 2e 20 49 66 20 69 74 0a 23 20 69 73 20 6e 6f 74 . If it.# is not
1100: 20 72 75 6e 6e 69 6e 67 20 6f 72 20 66 6f 72 20 running or for
1110: 73 6f 6d 65 20 6f 74 68 65 72 20 72 65 61 73 6f some other reaso
1120: 6e 20 74 68 65 20 63 6f 6e 6e 65 63 74 20 66 61 n the connect fa
1130: 69 6c 73 2c 20 61 74 74 65 6d 70 74 20 74 6f 0a ils, attempt to.
1140: 23 20 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f # start the remo
1150: 74 65 20 73 65 72 76 65 72 20 6f 6e 20 74 68 65 te server on the
1160: 20 6c 6f 63 61 6c 20 68 6f 73 74 20 6c 69 73 74 local host list
1170: 65 6e 69 6e 67 20 6f 6e 20 70 6f 72 74 20 32 30 ening on port 20
1180: 34 38 2e 20 54 68 69 73 0a 23 20 69 73 20 6f 6e 48. This.# is on
1190: 6c 79 20 64 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 ly done on platf
11a0: 6f 72 6d 73 20 74 68 61 74 20 73 75 70 70 6f 72 orms that suppor
11b0: 74 20 65 78 65 63 20 28 69 2e 65 2e 20 6e 6f 74 t exec (i.e. not
11c0: 20 6f 6e 20 74 68 65 20 4d 61 63 29 2e 20 4f 6e on the Mac). On
11d0: 0a 23 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 .# platforms tha
11e0: 74 20 64 6f 20 6e 6f 74 20 73 75 70 70 6f 72 74 t do not support
11f0: 20 65 78 65 63 2c 20 74 68 65 20 72 65 6d 6f 74 exec, the remot
1200: 65 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 e server must be
1210: 20 73 74 61 72 74 65 64 0a 23 20 62 79 20 74 68 started.# by th
1220: 65 20 75 73 65 72 20 62 65 66 6f 72 65 20 72 75 e user before ru
1230: 6e 6e 69 6e 67 20 74 68 65 20 74 65 73 74 73 2e nning the tests.
1240: 0a 0a 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 ..set remoteProc
1250: 43 68 61 6e 20 22 22 0a 73 65 74 20 63 6f 6d 6d Chan "".set comm
1260: 61 6e 64 53 6f 63 6b 65 74 20 22 22 0a 69 66 20 andSocket "".if
1270: 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d {$doTestsWithRem
1280: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
1290: 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 catch {close $c
12a0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 ommandSocket}.
12b0: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 if {[catch {se
12c0: 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 t commandSocket
12d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
12e0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
12f0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
1300: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
1310: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
1320: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
1330: 65 72 49 50 20 5c 0a 09 20 20 20 20 24 72 65 6d erIP \.. $rem
1340: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d oteServerPort]}]
1350: 20 21 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 != 0} {..if {[i
1360: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 nfo commands exe
1370: 63 5d 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 c] == ""} {..
1380: 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 set noRemoteTes
1390: 74 52 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 tReason "can't e
13a0: 78 65 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f xec".. set do
13b0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
13c0: 65 72 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 erver 0..} else
13d0: 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 {.. set remot
13e0: 65 53 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e eServerIP 127.0.
13f0: 30 2e 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 0.1.. set rem
1400: 6f 74 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f oteFile [file jo
1410: 69 6e 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e in [pwd] remote.
1420: 74 63 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 tcl].. if {[c
1430: 61 74 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 atch {set remote
1440: 50 72 6f 63 43 68 61 6e 20 5c 0a 09 09 09 09 5b ProcChan \.....[
1450: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
1460: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
1470: 20 24 72 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 $remoteFile \..
1480: 09 09 09 09 2d 73 65 72 76 65 72 49 73 53 69 6c ....-serverIsSil
1490: 65 6e 74 20 5c 0a 09 09 09 09 09 2d 70 6f 72 74 ent \......-port
14a0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f $remoteServerPo
14b0: 72 74 20 5c 0a 09 09 09 09 09 2d 61 64 64 72 65 rt \......-addre
14c0: 73 73 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 ss $remoteServer
14d0: 49 50 5d 22 20 5c 0a 09 09 09 09 09 77 2b 5d 7d IP]" \......w+]}
14e0: 20 5c 0a 09 09 20 20 20 6d 73 67 5d 20 3d 3d 20 \... msg] ==
14f0: 30 7d 20 7b 0a 09 09 61 66 74 65 72 20 31 30 30 0} {...after 100
1500: 30 0a 09 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 0...if {[catch {
1510: 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 set commandSocke
1520: 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c t [tls::socket \
1530: 0a 09 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 ... -certfile
1540: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
1550: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
1560: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
1570: 20 5c 0a 09 09 09 09 24 72 65 6d 6f 74 65 53 65 \.....$remoteSe
1580: 72 76 65 72 49 50 20 5c 0a 09 09 09 09 24 72 65 rverIP \.....$re
1590: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d moteServerPort]}
15a0: 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 msg] == 0} {...
15b0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
15c0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 commandSocket -t
15d0: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 ranslation crlf
15e0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
15f0: 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 ..} else {...
1600: 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 set noRemoteTes
1610: 74 52 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 tReason $msg...
1620: 20 20 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 set doTestsWi
1630: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 thRemoteServer 0
1640: 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 ...}.. } else
1650: 20 7b 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 {...set noRemot
1660: 65 54 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 eTestReason "$ms
1670: 67 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 g $::tcltest::tc
1680: 6c 74 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54 ltest"...set doT
1690: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
16a0: 72 76 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d rver 0.. }..}
16b0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 . } else {..f
16c0: 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 configure $comma
16d0: 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c ndSocket -transl
16e0: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 ation crlf -buff
16f0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d ering line. }
1700: 0a 7d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 .}..# Some tests
1710: 20 61 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 are run only if
1720: 20 77 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65 we are doing te
1730: 73 74 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20 sting against a
1740: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 remote server..s
1750: 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 et ::tcltest::te
1760: 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f stConstraints(do
1770: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1780: 65 72 76 65 72 29 20 24 64 6f 54 65 73 74 73 57 erver) $doTestsW
1790: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a ithRemoteServer.
17a0: 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 if {$doTestsWith
17b0: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 RemoteServer ==
17c0: 30 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 0} {. if {[st
17d0: 72 69 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a ring first s $::
17e0: 74 63 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 tcltest::verbose
17f0: 5d 20 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 ] != -1} {. .
1800: 70 75 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74 puts "Skipping t
1810: 65 73 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65 ests with remote
1820: 20 73 65 72 76 65 72 2e 20 53 65 65 20 74 65 73 server. See tes
1830: 74 73 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 ts/socket.test f
1840: 6f 72 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 or"..puts "infor
1850: 6d 61 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f mation on how to
1860: 20 72 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 run remote serv
1870: 65 72 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73 er."..puts "Reas
1880: 6f 6e 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 on for not doing
1890: 20 72 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 remote tests: $
18a0: 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 noRemoteTestReas
18b0: 6f 6e 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 on". }.}..#.#
18c0: 20 49 66 20 77 65 20 64 6f 20 74 68 65 20 74 65 If we do the te
18d0: 73 74 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f sts, define a co
18e0: 6d 6d 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 mmand to send a
18f0: 63 6f 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 command to the.#
1900: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a remote server..
1910: 23 0a 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 #..if {$doTestsW
1920: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
1930: 3d 3d 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 == 1} {. proc
1940: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d sendCommand {c}
1950: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 {..global comma
1960: 6e 64 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b ndSocket...if {[
1970: 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b eof $commandSock
1980: 65 74 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f et]} {.. erro
1990: 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 r "remote server
19a0: 20 64 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d disappeared"..}
19b0: 0a 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 ...if {[catch {p
19c0: 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b uts $commandSock
19d0: 65 74 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 et $c} msg]} {..
19e0: 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 error "remot
19f0: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 61 e server disappa
1a00: 65 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 ered: $msg"..}..
1a10: 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 if {[catch {puts
1a20: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
1a30: 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 "--Marker--Marke
1a40: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 r--Marker--"} ms
1a50: 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 g]} {.. error
1a60: 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 "remote server
1a70: 64 69 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 disappeared: $ms
1a80: 67 22 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 g"..}...set resp
1a90: 20 22 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b ""..while {1} {
1aa0: 0a 09 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b .. set line [
1ab0: 67 65 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 gets $commandSoc
1ac0: 6b 65 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 ket].. if {[e
1ad0: 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 of $commandSocke
1ae0: 74 5d 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 t]} {...error "r
1af0: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 emote server dis
1b00: 61 70 70 65 61 72 65 64 22 0a 09 20 20 20 20 7d appeared".. }
1b10: 0a 09 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e .. if {[strin
1b20: 67 20 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 g compare $line
1b30: 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 "--Marker--Marke
1b40: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d r--Marker--"] ==
1b50: 20 30 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 0} {...if {[str
1b60: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e ing compare [lin
1b70: 64 65 78 20 24 72 65 73 70 20 30 5d 20 65 72 72 dex $resp 0] err
1b80: 6f 72 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 or] == 0} {...
1b90: 20 20 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 error [lindex
1ba0: 24 72 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 $resp 1]...} els
1bb0: 65 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e e {... return
1bc0: 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 [lindex $resp 1
1bd0: 5d 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 ]...}.. } els
1be0: 65 20 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 e {...append res
1bf0: 70 20 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 p $line "\n"..
1c00: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a }..}. }.}..
1c10: 74 65 73 74 20 74 6c 73 49 6f 2d 31 2e 31 20 7b test tlsIo-1.1 {
1c20: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
1c30: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
1c40: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
1c50: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
1c60: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d :socket -server}
1c70: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
1c80: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
1c90: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
1ca0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f ocket -server co
1cb0: 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 mmand ?options?
1cc0: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
1cd0: 73 49 6f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 sIo-1.2 {arg par
1ce0: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
1cf0: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
1d00: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
1d10: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
1d20: 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 -server foo} ms
1d30: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
1d40: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
1d50: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
1d60: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
1d70: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
1d80: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f t"}}..test tlsIo
1d90: 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e -1.3 {arg parsin
1da0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
1db0: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
1dc0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
1dd0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
1de0: 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 yaddr} msg] $msg
1df0: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
1e00: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
1e10: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
1e20: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
1e30: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 }}..test tlsIo-1
1e40: 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .4 {arg parsing
1e50: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1e60: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1e70: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1e80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
1e90: 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d ddr 127.0.0.1} m
1ea0: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
1eb0: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
1ec0: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
1ed0: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
1ee0: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
1ef0: 20 74 6c 73 49 6f 2d 31 2e 35 20 7b 61 72 67 20 tlsIo-1.5 {arg
1f00: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
1f10: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
1f20: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
1f30: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
1f40: 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 ket -myport} msg
1f50: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
1f60: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
1f70: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
1f80: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
1f90: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
1fa0: 6c 73 49 6f 2d 31 2e 36 20 7b 61 72 67 20 70 61 lsIo-1.6 {arg pa
1fb0: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
1fc0: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
1fd0: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
1fe0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
1ff0: 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 t -myport xxxx}
2000: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
2010: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
2020: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
2030: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
2040: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
2050: 74 20 74 6c 73 49 6f 2d 31 2e 37 20 7b 61 72 67 t tlsIo-1.7 {arg
2060: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2070: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2080: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2090: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
20a0: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 cket -myport 252
20b0: 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 2} msg] $msg.} {
20c0: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
20d0: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
20e0: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
20f0: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
2100: 74 65 73 74 20 74 6c 73 49 6f 2d 31 2e 38 20 7b test tlsIo-1.8 {
2110: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2120: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2130: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2140: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2150: 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a 7d :socket -froboz}
2160: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
2170: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
2180: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
2190: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
21a0: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
21b0: 73 74 20 74 6c 73 49 6f 2d 31 2e 39 20 7b 61 72 st tlsIo-1.9 {ar
21c0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
21d0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
21e0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
21f0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2200: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f ocket -server fo
2210: 6f 20 2d 6d 79 70 6f 72 74 20 32 35 32 31 20 33 o -myport 2521 3
2220: 33 33 33 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 333} msg] $msg.}
2230: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2240: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2250: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2260: 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f r command ?optio
2270: 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ns? port"}}..tes
2280: 74 20 74 6c 73 49 6f 2d 31 2e 31 30 20 7b 61 72 t tlsIo-1.10 {ar
2290: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
22a0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
22b0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
22c0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
22d0: 6f 63 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 ocket host 2528
22e0: 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 -junk} msg] $msg
22f0: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
2300: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
2310: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
2320: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
2330: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 }}..test tlsIo-1
2340: 2e 31 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 .11 {arg parsing
2350: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2360: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2370: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2380: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2390: 72 76 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 rver callback 25
23a0: 32 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 20 --} msg] $msg
23b0: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
23c0: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
23d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
23e0: 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 ver command ?opt
23f0: 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 ions? port"}}..t
2400: 65 73 74 20 74 6c 73 49 6f 2d 31 2e 31 32 20 7b est tlsIo-1.12 {
2410: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2420: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2430: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2440: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2450: 3a 73 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 :socket foo badp
2460: 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d ort} msg] $msg.}
2470: 20 7b 31 20 7b 65 78 70 65 63 74 65 64 20 69 6e {1 {expected in
2480: 74 65 67 65 72 20 62 75 74 20 67 6f 74 20 22 62 teger but got "b
2490: 61 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 adport"}}..test
24a0: 74 6c 73 49 6f 2d 32 2e 31 20 7b 74 63 70 20 63 tlsIo-2.1 {tcp c
24b0: 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b onnection} {sock
24c0: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
24d0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
24e0: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
24f0: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
2500: 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 puts $f {. .p
2510: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
2520: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
2530: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
2540: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
2550: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
2560: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
2570: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
2580: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
2590: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
25a0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
25b0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 e $serverKey 282
25c0: 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 8 \]". puts $
25d0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
25e0: 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 {file addr port
25f0: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
2600: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
2610: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c e. cl
2620: 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 ose $file..}..pu
2630: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
2640: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
2650: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
2660: 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a ..puts $x. }.
2670: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
2680: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
2690: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
26a0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
26b0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
26c0: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
26d0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
26e0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
26f0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
2700: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
2710: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
2720: 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 5d 0.0.1 2828} msg]
2730: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
2740: 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 x $msg. } els
2750: 65 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 e {. lapp
2760: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
2770: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d close $m
2780: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 sg. }. lap
2790: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
27a0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
27b0: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
27c0: 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 done {}}..if [i
27d0: 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d nfo exists port]
27e0: 20 7b 0a 20 20 20 20 69 6e 63 72 20 70 6f 72 74 {. incr port
27f0: 0a 7d 20 65 6c 73 65 20 7b 20 0a 20 20 20 20 73 .} else { . s
2800: 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 32 30 et port [expr 20
2810: 34 38 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 48 + [pid]%1024]
2820: 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 32 .}..test tlsIo-2
2830: 2e 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .2 {tcp connecti
2840: 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 on with client p
2850: 6f 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b ort specified} {
2860: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
2870: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
2880: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
2890: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
28a0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
28b0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
28c0: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
28d0: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
28e0: 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 done"]. }.
28f0: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
2900: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
2910: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
2920: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
2930: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
2940: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
2950: 72 76 65 72 4b 65 79 20 32 38 32 39 20 5c 5d 22 rverKey 2829 \]"
2960: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
2970: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
2980: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 e addr port} {.
2990: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
29a0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
29b0: 70 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 6c puts "[gets $fil
29c0: 65 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 20 20 e] $port".
29d0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c close $fil
29e0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 e. se
29f0: 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 t x done..}..put
2a00: 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 s ready..vwait x
2a10: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
2a20: 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a timer..close $f.
2a30: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
2a40: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
2a50: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
2a60: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
2a70: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
2a80: 65 74 73 20 24 66 20 78 0a 20 20 20 20 67 6c 6f ets $f x. glo
2a90: 62 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 20 bal port. if
2aa0: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
2ab0: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 6f cket -myport $po
2ac0: 72 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 rt \..-certfile
2ad0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
2ae0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
2af0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
2b00: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 ey 127.0.0.1 282
2b10: 39 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 9} sock]} {.
2b20: 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a set x $sock.
2b30: 09 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b 74 .catch {close [t
2b40: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
2b50: 2e 30 2e 31 20 32 38 32 39 5d 7d 0a 20 20 20 20 .0.1 2829]}.
2b60: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
2b70: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
2b80: 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 o..flush $sock.
2b90: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
2ba0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
2bb0: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
2bc0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2bd0: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 5b 6c f. set x.} [l
2be0: 69 73 74 20 72 65 61 64 79 20 22 68 65 6c 6c 6f ist ready "hello
2bf0: 20 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 74 $port"]..test t
2c00: 6c 73 49 6f 2d 32 2e 33 20 7b 74 63 70 20 63 6f lsIo-2.3 {tcp co
2c10: 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c nnection with cl
2c20: 69 65 6e 74 20 69 6e 74 65 72 66 61 63 65 20 73 ient interface s
2c30: 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 pecified} {socke
2c40: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
2c50: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
2c60: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
2c70: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
2c80: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
2c90: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
2ca0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
2cb0: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
2cc0: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
2cd0: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
2ce0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2cf0: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
2d00: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
2d10: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
2d20: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
2d30: 65 79 20 32 38 33 30 20 5c 5d 22 0a 20 20 20 20 ey 2830 \]".
2d40: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
2d50: 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 accept {file add
2d60: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 r port} {.
2d70: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
2d80: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
2d90: 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 20 24 61 "[gets $file] $a
2da0: 64 64 72 22 0a 20 20 20 20 20 20 20 20 20 20 20 ddr".
2db0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 close $file.
2dc0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
2dd0: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
2de0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
2df0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
2e00: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
2e10: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
2e20: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
2e30: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
2e40: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
2e50: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
2e60: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
2e70: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2e80: 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e -myaddr 127.0.0.
2e90: 31 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 1 \..-certfile $
2ea0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
2eb0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
2ec0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
2ed0: 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 30 y 127.0.0.1 2830
2ee0: 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 } sock]} {.
2ef0: 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 set x $sock.
2f00: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
2f10: 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 puts $sock h
2f20: 65 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 ello..catch {flu
2f30: 73 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 sh $sock}.
2f40: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
2f50: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
2f60: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
2f70: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
2f80: 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 set x.} {ready
2f90: 7b 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 {hello 127.0.0.1
2fa0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 32 }}..test tlsIo-2
2fb0: 2e 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .4 {tcp connecti
2fc0: 6f 6e 20 77 69 74 68 20 73 65 72 76 65 72 20 69 on with server i
2fd0: 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 66 69 nterface specifi
2fe0: 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ed} {socket stdi
2ff0: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
3000: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
3010: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
3020: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
3030: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
3040: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
3050: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
3060: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 set x done"].
3070: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
3080: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
3090: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
30a0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
30b0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
30c0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
30d0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 e $serverKey -my
30e0: 61 64 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e addr [info hostn
30f0: 61 6d 65 5d 20 32 38 33 31 20 5c 5d 22 0a 20 20 ame] 2831 \]".
3100: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
3110: 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 c accept {file a
3120: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 ddr port} {.
3130: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
3140: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
3150: 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 s "[gets $file]"
3160: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
3170: 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 se $file.
3180: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
3190: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
31a0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
31b0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
31c0: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
31d0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
31e0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
31f0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
3200: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
3210: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
3220: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
3230: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
3240: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
3250: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3260: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
3270: 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 lientKey [info h
3280: 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 7d 20 73 ostname] 2831} s
3290: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
32a0: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
32b0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
32c0: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
32d0: 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 o..flush $sock.
32e0: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
32f0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
3300: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
3310: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3320: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 f. set x.} {r
3330: 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 eady hello}..tes
3340: 74 20 74 6c 73 49 6f 2d 32 2e 35 20 7b 74 63 70 t tlsIo-2.5 {tcp
3350: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 connection with
3360: 20 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 redundant serve
3370: 72 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 r port} {socket
3380: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
3390: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
33a0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
33b0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
33c0: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
33d0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
33e0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
33f0: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
3400: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
3410: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
3420: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
3430: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
3440: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
3450: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
3460: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
3470: 20 32 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 75 2832 \]". pu
3480: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
3490: 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 cept {file addr
34a0: 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 port} {.
34b0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
34c0: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b puts "[
34d0: 67 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 20 gets $file]".
34e0: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
34f0: 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 file.
3500: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
3510: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
3520: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
3530: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
3540: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
3550: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
3560: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
3570: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
3580: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
3590: 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 gets $f x.
35a0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
35b0: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
35c0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
35d0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
35e0: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
35f0: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 tKey 127.0.0.1 2
3600: 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 832} sock]} {.
3610: 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 set x $soc
3620: 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 k. } else {.
3630: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 puts $soc
3640: 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 k hello..flush $
3650: 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 sock. lap
3660: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
3670: 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 . close $
3680: 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 sock. }. c
3690: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
36a0: 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f x.} {ready hello
36b0: 7d 0a 74 65 73 74 20 74 6c 73 49 6f 2d 32 2e 36 }.test tlsIo-2.6
36c0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
36d0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
36e0: 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 set status ok.
36f0: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
3700: 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 set sock [tls::s
3710: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
3720: 32 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 2833]}]} {..if {
3730: 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 ![catch {gets $s
3740: 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 ock}]} {.. se
3750: 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a t status broken.
3760: 09 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a .}..close $sock.
3770: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 }. set st
3780: 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 atus.} ok..test
3790: 74 6c 73 49 6f 2d 32 2e 37 20 7b 65 63 68 6f 20 tlsIo-2.7 {echo
37a0: 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 server, one line
37b0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
37c0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
37d0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
37e0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
37f0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
3800: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
3810: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
3820: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
3830: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
3840: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3850: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3860: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3870: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
3880: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
3890: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
38a0: 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 34 20 $serverKey 2834
38b0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
38c0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
38d0: 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 s a p} {.
38e0: 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 fileevent $
38f0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
3900: 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 echo $s].. f
3910: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
3920: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 anslation lf -bu
3930: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
3940: 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 }..proc ech
3950: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 o {s} {.. se
3960: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
3970: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
3980: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
3990: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
39a0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
39b0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39d0: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
39e0: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
39f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3a00: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
3a10: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
3a20: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
3a30: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
3a40: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
3a50: 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 $f..puts done.
3a60: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
3a70: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
3a80: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
3a90: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
3aa0: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
3ab0: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
3ac0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
3ad0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
3ae0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3af0: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
3b00: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
3b10: 2e 31 20 32 38 33 34 5d 0a 20 20 20 20 66 63 6f .1 2834]. fco
3b20: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
3b30: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
3b40: 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 slation lf. p
3b50: 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 uts $s "hello ab
3b60: 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a cdefghijklmnop".
3b70: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 after 1000.
3b80: 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 set x [gets $
3b90: 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a s]. close $s.
3ba0: 20 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 20 set y [gets
3bb0: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
3bc0: 0a 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 0a . list $x $y.
3bd0: 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 } {{hello abcdef
3be0: 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 ghijklmnop} done
3bf0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 32 2e }..test tlsIo-2.
3c00: 38 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 8 {echo server,
3c10: 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 73 loop 50 times, s
3c20: 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e ingle connection
3c30: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
3c40: 20 7b 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 {. set f [op
3c50: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
3c60: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
3c70: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
3c80: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
3c90: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
3ca0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
3cb0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
3cc0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
3cd0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
3ce0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
3cf0: 4b 65 79 20 32 38 33 35 20 5c 5d 22 0a 20 20 20 Key 2835 \]".
3d00: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
3d10: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
3d20: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 {. fi
3d30: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
3d40: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
3d50: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 s]. f
3d60: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
3d70: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
3d80: 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 }..proc ech
3d90: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c o {s} {.. gl
3da0: 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 obal i.
3db0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
3dc0: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
3dd0: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
3de0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3df0: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
3e00: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
3e10: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
3e20: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
3e30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 . }
3e40: 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 else { ..
3e50: 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 incr i.
3e60: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
3e70: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
3e80: 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a }..}..set i 0.
3e90: 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 .puts ready..set
3ea0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
3eb0: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
3ec0: 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 ]..vwait x..afte
3ed0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
3ee0: 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 .close $f..puts
3ef0: 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d 0a "done $i". }.
3f00: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3f10: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
3f20: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
3f30: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
3f40: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
3f50: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
3f60: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
3f70: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3f80: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3f90: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
3fa0: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 tKey 127.0.0.1 2
3fb0: 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 835]. fconfig
3fc0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
3fd0: 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 68 g line. catch
3fe0: 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 30 {..for {set x 0
3ff0: 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 } {$x < 50} {inc
4000: 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 r x} {.. puts
4010: 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 $s "hello abcde
4020: 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 fghijklmnop"..
4030: 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 20 gets $s..}.
4040: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a }. close $s.
4050: 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 78 catch {set x
4060: 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 [gets $f]}.
4070: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
4080: 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a x.} {done 50}..
4090: 74 65 73 74 20 74 6c 73 49 6f 2d 32 2e 39 20 7b test tlsIo-2.9 {
40a0: 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d socket conflict}
40b0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
40c0: 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 {. set s [tls
40d0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
40e0: 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 20 20 accept 2828].
40f0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
4100: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
4110: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
4120: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
4130: 65 20 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 e $f {package re
4140: 71 75 69 72 65 20 74 6c 73 3b 20 74 6c 73 3a 3a quire tls; tls::
4150: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4160: 63 63 65 70 74 20 32 38 32 38 7d 0a 20 20 20 20 ccept 2828}.
4170: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
4180: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
4190: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
41a0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
41b0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
41c0: 20 61 66 74 65 72 20 31 30 30 0a 20 20 20 20 73 after 100. s
41d0: 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 et x [list [catc
41e0: 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 67 h {close $f} msg
41f0: 5d 20 24 6d 73 67 5d 0a 20 20 20 20 63 6c 6f 73 ] $msg]. clos
4200: 65 20 24 73 0a 20 20 20 20 73 65 74 20 78 0a 7d e $s. set x.}
4210: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
4220: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
4230: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
4240: 65 0a 20 20 20 20 77 68 69 6c 65 20 65 78 65 63 e. while exec
4250: 75 74 69 6e 67 0a 22 3a 3a 73 6f 63 6b 65 74 20 uting."::socket
4260: 2d 73 65 72 76 65 72 20 7b 74 6c 73 3a 3a 5f 61 -server {tls::_a
4270: 63 63 65 70 74 20 7b 2d 73 65 72 76 65 72 20 31 ccept {-server 1
4280: 7d 20 61 63 63 65 70 74 7d 20 32 38 32 38 22 0a } accept} 2828".
4290: 20 20 20 20 28 22 65 76 61 6c 22 20 62 6f 64 79 ("eval" body
42a0: 20 6c 69 6e 65 20 31 29 0a 20 20 20 20 69 6e 76 line 1). inv
42b0: 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 68 69 6e oked from within
42c0: 0a 22 65 76 61 6c 20 3a 3a 73 6f 63 6b 65 74 20 ."eval ::socket
42d0: 24 73 6f 70 74 73 22 0a 20 20 20 20 28 70 72 6f $sopts". (pro
42e0: 63 65 64 75 72 65 20 22 74 6c 73 3a 3a 73 6f 63 cedure "tls::soc
42f0: 6b 65 74 22 20 6c 69 6e 65 20 36 32 29 0a 20 20 ket" line 62).
4300: 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 invoked from w
4310: 69 74 68 69 6e 0a 22 74 6c 73 3a 3a 73 6f 63 6b ithin."tls::sock
4320: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4330: 74 20 32 38 32 38 22 0a 20 20 20 20 28 66 69 6c t 2828". (fil
4340: 65 20 22 73 63 72 69 70 74 22 20 6c 69 6e 65 20 e "script" line
4350: 31 29 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 1)}}..test tlsIo
4360: 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 -2.10 {close on
4370: 61 63 63 65 70 74 2c 20 61 63 63 65 70 74 65 64 accept, accepted
4380: 20 73 6f 63 6b 65 74 20 6c 69 76 65 73 7d 20 7b socket lives} {
4390: 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 7d socket knownBug}
43a0: 20 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 {. set done
43b0: 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 0. set timer
43c0: 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 [after 20000 "se
43d0: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
43e0: 22 5d 0a 20 20 20 20 73 65 74 20 73 73 20 5b 74 "]. set ss [t
43f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4400: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
4410: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
4420: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4430: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 \..-keyfile $ser
4440: 76 65 72 4b 65 79 20 32 38 33 30 5d 0a 20 20 20 verKey 2830].
4450: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
4460: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 a p} {..global s
4470: 73 0a 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 s..close $ss..fi
4480: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
4490: 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a ble "readit $s".
44a0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
44b0: 74 72 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 trans lf. }.
44c0: 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b proc readit {
44d0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e s} {..global don
44e0: 65 0a 09 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 e..gets $s..clos
44f0: 65 20 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 e $s..set done 1
4500: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 . }. set c
4510: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
4520: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
4530: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4540: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
4550: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 $clientKey [inf
4560: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 o hostname] 2830
4570: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a ]. close $cs.
4580: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
4590: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
45a0: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 20 $timer. set
45b0: 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 74 done.} 1..test t
45c0: 6c 73 49 6f 2d 32 2e 31 31 20 7b 64 65 74 65 63 lsIo-2.11 {detec
45d0: 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 7b ting new data} {
45e0: 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 7d socket knownBug}
45f0: 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 {. proc acce
4600: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
4610: 6f 62 61 6c 20 73 6f 63 6b 0a 09 73 65 74 20 73 obal sock..set s
4620: 6f 63 6b 20 24 73 0a 09 73 65 74 20 66 20 5b 6f ock $s..set f [o
4630: 70 65 6e 20 61 77 62 2e 6c 6f 67 20 77 5d 0a 09 pen awb.log w]..
4640: 70 75 74 73 20 24 66 20 5b 63 61 74 63 68 20 7b puts $f [catch {
4650: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
4660: 73 6f 63 6b 7d 20 65 72 72 5d 0a 09 70 75 74 73 sock} err]..puts
4670: 20 24 66 20 22 65 72 72 3a 20 24 65 72 72 22 0a $f "err: $err".
4680: 09 70 75 74 73 20 24 66 20 22 5b 74 6c 73 3a 3a .puts $f "[tls::
4690: 73 74 61 74 75 73 20 24 73 6f 63 6b 5d 22 0a 09 status $sock]"..
46a0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 0a close $s. }..
46b0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
46c0: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
46d0: 30 20 2d 72 65 71 75 65 73 74 20 30 20 2d 73 65 0 -request 0 -se
46e0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
46f0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
4700: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4710: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 t \..-keyfile $s
4720: 65 72 76 65 72 4b 65 79 20 32 34 30 30 5d 0a 20 erverKey 2400].
4730: 20 20 20 73 65 74 20 73 6f 63 6b 20 22 22 0a 20 set sock "".
4740: 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a set s2 [tls::
4750: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
4760: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
4770: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
4780: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
4790: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 34 Key 127.0.0.1 24
47a0: 30 30 5d 0a 20 20 20 20 76 77 61 69 74 20 73 6f 00]. vwait so
47b0: 63 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 ck. puts $s2
47c0: 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 one. flush $s
47d0: 32 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0a 2. after 500.
47e0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
47f0: 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 sock -blocking 0
4800: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 20 . set result
4810: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
4820: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
4830: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
4840: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
4850: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 k -blocking 1.
4860: 20 20 70 75 74 73 20 24 73 32 20 74 77 6f 0a 20 puts $s2 two.
4870: 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 flush $s2.
4880: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
4890: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 k -blocking 0.
48a0: 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 lappend result
48b0: 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 [gets $sock].
48c0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
48d0: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 ck -blocking 1.
48e0: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
48f0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
4900: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 ose $sock. se
4910: 74 20 72 65 73 75 6c 74 0a 7d 20 7b 6f 6e 65 20 t result.} {one
4920: 7b 7d 20 74 77 6f 7d 0a 0a 74 65 73 74 20 74 6c {} two}..test tl
4930: 73 49 6f 2d 32 2e 31 32 20 7b 74 63 70 20 63 6f sIo-2.12 {tcp co
4940: 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 nnection; no cer
4950: 74 69 66 69 63 61 74 65 73 20 73 70 65 63 69 66 tificates specif
4960: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ied} {socket std
4970: 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 io pcCrash} {.
4980: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
4990: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
49a0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
49b0: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
49c0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
49d0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
49e0: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
49f0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 x timed_out"]..
4a00: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
4a10: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4a20: 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 t 2828]..proc ac
4a30: 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 cept {file addr
4a40: 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f port} {.. glo
4a50: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
4a60: 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 done.
4a70: 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d close $file..}
4a80: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
4a90: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
4aa0: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
4ab0: 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 e $f..puts $x.
4ac0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
4ad0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4ae0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
4af0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
4b00: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
4b10: 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b s $f x. if {[
4b20: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
4b30: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 et 127.0.0.1 282
4b40: 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 8} msg]} {.
4b50: 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 set x $msg.
4b60: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
4b70: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
4b80: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
4b90: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
4ba0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
4bb0: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
4bc0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
4bd0: 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d {ready done {}}
4be0: 0a 0a 0a 0a 0a 23 23 23 23 23 23 23 23 23 23 23 .....###########
4bf0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4c00: 23 23 23 23 23 23 0a 69 66 20 7b 5b 73 74 72 69 ######.if {[stri
4c10: 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 ng match sock* $
4c20: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d commandSocket] =
4c30: 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 = 1} {. puts $
4c40: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 commandSocket ex
4c50: 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 6f 6d it. flush $com
4c60: 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 mandSocket.}.cat
4c70: 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 ch {close $comma
4c80: 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 ndSocket}.catch
4c90: 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 {close $remotePr
4ca0: 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 ocChan}.::tcltes
4cb0: 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 0a t::cleanupTests.
4cc0: 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 65 74 flush stdout.ret
4cd0: 75 72 6e 0a 23 23 23 23 23 23 23 23 23 23 23 23 urn.############
4ce0: 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 23 ################
4cf0: 23 23 23 23 23 0a 74 65 73 74 20 74 6c 73 49 6f #####.test tlsIo
4d00: 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e -3.1 {socket con
4d10: 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 flict} {socket s
4d20: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
4d30: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
4d40: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
4d50: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
4d60: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
4d70: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
4d80: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
4d90: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
4da0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4db0: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
4dc0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
4dd0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
4de0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 ile $serverKey 2
4df0: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 828 \]". puts
4e00: 20 24 66 20 7b 0a 09 70 75 74 73 20 72 65 61 64 $f {..puts read
4e10: 79 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 63 y..gets stdin..c
4e20: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
4e30: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
4e40: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
4e50: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
4e60: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
4e70: 72 2b 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r+]. gets $f.
4e80: 20 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 set x [list
4e90: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
4ea0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
4eb0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
4ec0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4ed0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
4ee0: 74 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 tKey \. .-ser
4ef0: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 7d ver accept 2828}
4f00: 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a msg] \...$msg].
4f10: 20 20 20 20 70 75 74 73 20 24 66 20 62 79 65 0a puts $f bye.
4f20: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
4f30: 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 set x.} {1 {cou
4f40: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
4f50: 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 t: address alrea
4f60: 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 dy in use}}..tes
4f70: 74 20 74 6c 73 49 6f 2d 33 2e 32 20 7b 73 65 72 t tlsIo-3.2 {ser
4f80: 76 65 72 20 77 69 74 68 20 73 65 76 65 72 61 6c ver with several
4f90: 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 clients} {socke
4fa0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
4fb0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
4fc0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4fd0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
4fe0: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
4ff0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
5000: 73 0a 09 73 65 74 20 74 31 20 5b 61 66 74 65 72 s..set t1 [after
5010: 20 33 30 30 30 30 20 22 73 65 74 20 78 20 74 69 30000 "set x ti
5020: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 med_out"]..set t
5030: 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 2 [after 31000 "
5040: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5050: 5d 0a 09 73 65 74 20 74 33 20 5b 61 66 74 65 72 ]..set t3 [after
5060: 20 33 32 30 30 30 20 22 73 65 74 20 78 20 74 69 32000 "set x ti
5070: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 63 med_out"]..set c
5080: 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 7d 0a 20 ounter 0. }.
5090: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
50a0: 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s \[tls::socket
50b0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
50c0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
50d0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
50e0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
50f0: 65 72 76 65 72 4b 65 79 20 32 38 32 38 20 5c 5d erverKey 2828 \]
5100: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
5110: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
5120: 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 a p} {.. file
5130: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
5140: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
5150: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
5160: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
5170: 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 ine..}..proc ech
5180: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c o {s} {.. gl
5190: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
51a0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
51b0: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
51c0: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
51d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
51e0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
51f0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
5200: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
5210: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
5220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
5230: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
5240: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 }..}..puts
5250: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
5260: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
5270: 31 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 1..vwait x..afte
5280: 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 r cancel $t2..vw
5290: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
52a0: 63 65 6c 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 cel $t3..close $
52b0: 73 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d s..puts $x. }
52c0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
52d0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
52e0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
52f0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
5300: 5d 22 20 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 ]" r+]. set x
5310: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 73 [gets $f]. s
5320: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
5330: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
5340: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
5350: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
5360: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
5370: 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 Key \.. 127.0
5380: 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 66 .0.1 2828]. f
5390: 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 configure $s1 -b
53a0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
53b0: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
53c0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
53d0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
53e0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
53f0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
5400: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
5410: 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 7.0.0.1 2828].
5420: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 fconfigure $s2
5430: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5440: 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 . set s3 [tls
5450: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
5460: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
5470: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
5480: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5490: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
54a0: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 127.0.0.1 2828]
54b0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
54c0: 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s3 -buffering l
54d0: 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 ine. for {set
54e0: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d i 0} {$i < 100}
54f0: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 {incr i} {..put
5500: 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 s $s1 hello,s1..
5510: 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 gets $s1..puts $
5520: 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 s2 hello,s2..get
5530: 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 s $s2..puts $s3
5540: 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 hello,s3..gets $
5550: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f s3. }. clo
5560: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 se $s1. close
5570: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
5580: 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 s3. lappend x
5590: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
55a0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
55b0: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d x.} {ready done}
55c0: 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 34 2e 31 ..test tlsIo-4.1
55d0: 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 {server with se
55e0: 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b veral clients} {
55f0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
5600: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
5610: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
5620: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
5630: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
5640: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
5650: 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 re tls..gets std
5660: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 in. }. put
5670: 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b 74 6c s $f "set s \[tl
5680: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
5690: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
56a0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
56b0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
56c0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 Key 127.0.0.1 28
56d0: 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 28 \]". puts
56e0: 24 66 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 $f {..fconfigure
56f0: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
5700: 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 ine..for {set i
5710: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
5720: 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 70 75 ncr i} {.. pu
5730: 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 20 20 20 ts $s hello..
5740: 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 63 6c 6f gets $s..}..clo
5750: 73 65 20 24 73 0a 09 70 75 74 73 20 62 79 65 0a se $s..puts bye.
5760: 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 .gets stdin.
5770: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
5780: 20 20 20 73 65 74 20 70 31 20 5b 6f 70 65 6e 20 set p1 [open
5790: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
57a0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
57b0: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f pt]" r+]. fco
57c0: 6e 66 69 67 75 72 65 20 24 70 31 20 2d 62 75 66 nfigure $p1 -buf
57d0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
57e0: 73 65 74 20 70 32 20 5b 6f 70 65 6e 20 22 7c 5b set p2 [open "|[
57f0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5800: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5810: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
5820: 67 75 72 65 20 24 70 32 20 2d 62 75 66 66 65 72 gure $p2 -buffer
5830: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
5840: 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 p3 [open "|[lis
5850: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
5860: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
5870: 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 +]. fconfigur
5880: 65 20 24 70 33 20 2d 62 75 66 66 65 72 69 6e 67 e $p3 -buffering
5890: 20 6c 69 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 line. proc a
58a0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
58b0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
58c0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
58d0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
58e0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
58f0: 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 $s]. }. p
5900: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
5910: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
5920: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
5930: 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f . if {[eo
5940: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
5950: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
5960: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
5970: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 7d 20 65 done. } e
5980: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 lse {.
5990: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
59a0: 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 }. }.
59b0: 20 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 set t1 [after 3
59c0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
59d0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 d_out"]. set
59e0: 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 t2 [after 31000
59f0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
5a00: 22 5d 0a 20 20 20 20 73 65 74 20 74 33 20 5b 61 "]. set t3 [a
5a10: 66 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 fter 32000 "set
5a20: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
5a30: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
5a40: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
5a50: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
5a60: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5a70: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
5a80: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
5a90: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 rver accept 2828
5aa0: 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 6f ]. puts $p1 o
5ab0: 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 32 pen. puts $p2
5ac0: 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 open. puts $
5ad0: 70 33 20 6f 70 65 6e 0a 20 20 20 20 76 77 61 69 p3 open. vwai
5ae0: 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a t x. vwait x.
5af0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
5b00: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 after cancel $t1
5b10: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
5b20: 6c 20 24 74 32 0a 20 20 20 20 61 66 74 65 72 20 l $t2. after
5b30: 63 61 6e 63 65 6c 20 24 74 33 0a 20 20 20 20 63 cancel $t3. c
5b40: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
5b50: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
5b60: 20 6c 20 5b 6c 69 73 74 20 70 31 20 5b 67 65 74 l [list p1 [get
5b70: 73 20 24 70 31 5d 20 24 78 5d 0a 20 20 20 20 6c s $p1] $x]. l
5b80: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 append l [list p
5b90: 32 20 5b 67 65 74 73 20 24 70 32 5d 20 24 78 5d 2 [gets $p2] $x]
5ba0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
5bb0: 6c 69 73 74 20 70 33 20 5b 67 65 74 73 20 24 70 list p3 [gets $p
5bc0: 33 5d 20 24 78 5d 0a 20 20 20 20 70 75 74 73 20 3] $x]. puts
5bd0: 24 70 31 20 62 79 65 0a 20 20 20 20 70 75 74 73 $p1 bye. puts
5be0: 20 24 70 32 20 62 79 65 0a 20 20 20 20 70 75 74 $p2 bye. put
5bf0: 73 20 24 70 33 20 62 79 65 0a 20 20 20 20 63 6c s $p3 bye. cl
5c00: 6f 73 65 20 24 70 31 0a 20 20 20 20 63 6c 6f 73 ose $p1. clos
5c10: 65 20 24 70 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $p2. close
5c20: 24 70 33 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 $p3. set l.}
5c30: 7b 7b 70 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b {{p1 bye done} {
5c40: 70 32 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 p2 bye done} {p3
5c50: 20 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 bye done}}..tes
5c60: 74 20 74 6c 73 49 6f 2d 34 2e 32 20 7b 62 79 74 t tlsIo-4.2 {byt
5c70: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
5c80: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
5c90: 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 , htons} {socket
5ca0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 6f 6b } {. set x ok
5cb0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
5cc0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
5cd0: 72 76 65 72 20 64 6f 64 6f 20 30 78 33 30 30 30 rver dodo 0x3000
5ce0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
5cf0: 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 $msg. } else
5d00: 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 {..close $msg.
5d10: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
5d20: 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d ok..test tlsIo-
5d30: 35 2e 31 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.1 {byte order
5d40: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
5d50: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
5d60: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 \..{socket unix
5d70: 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a Only notRoot} {.
5d80: 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 set x {could
5d90: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
5da0: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 not owner}.
5db0: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 if {![catch {tls
5dc0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
5dd0: 20 64 6f 64 6f 20 30 78 31 7d 20 6d 73 67 5d 7d dodo 0x1} msg]}
5de0: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
5df0: 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c {htons problem,
5e00: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
5e10: 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 lowed, are you r
5e20: 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 unning as SU?}..
5e30: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
5e40: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f . set x.} {co
5e50: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5e60: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 74 et: not owner}.t
5e70: 65 73 74 20 74 6c 73 49 6f 2d 35 2e 32 20 7b 62 est tlsIo-5.2 {b
5e80: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
5e90: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
5ea0: 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b rs, htons} {sock
5eb0: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 et} {. set x
5ec0: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
5ed0: 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 ocket: port numb
5ee0: 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 20 20 20 er too high}.
5ef0: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c if {![catch {tl
5f00: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5f10: 72 20 64 6f 64 6f 20 30 78 31 30 30 30 30 7d 20 r dodo 0x10000}
5f20: 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b msg]} {..set x {
5f30: 70 6f 72 74 20 72 65 73 6f 6c 75 74 69 6f 6e 20 port resolution
5f40: 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 problem, should
5f50: 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 7d 0a 09 be disallowed}..
5f60: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
5f70: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f . set x.} {co
5f80: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5f90: 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 et: port number
5fa0: 74 6f 6f 20 68 69 67 68 7d 0a 74 65 73 74 20 74 too high}.test t
5fb0: 6c 73 49 6f 2d 35 2e 33 20 7b 62 79 74 65 20 6f lsIo-5.3 {byte o
5fc0: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
5fd0: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
5fe0: 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 tons} \..{socket
5ff0: 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f unixOnly notRoo
6000: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b t} {. set x {
6010: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
6020: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
6030: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
6040: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
6050: 65 72 76 65 72 20 64 6f 64 6f 20 32 31 7d 20 6d erver dodo 21} m
6060: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 sg]} {..set x {h
6070: 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 tons problem, sh
6080: 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 ould be disallow
6090: 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e ed, are you runn
60a0: 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f ing as SU?}..clo
60b0: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
60c0: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 set x.} {could
60d0: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
60e0: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 not owner}..tes
60f0: 74 20 74 6c 73 49 6f 2d 36 2e 31 20 7b 61 63 63 t tlsIo-6.1 {acc
6100: 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 ept callback err
6110: 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 or} {socket stdi
6120: 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 o pcCrash} {.
6130: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
6140: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
6150: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
6160: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
6170: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
6180: 74 6c 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a tls..gets stdin.
6190: 09 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 .tls::socket 127
61a0: 2e 30 2e 30 2e 31 20 32 38 34 38 0a 20 20 20 20 .0.0.1 2848.
61b0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
61c0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
61d0: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
61e0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
61f0: 74 5d 22 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 t]" r+]. proc
6200: 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a bgerror args {.
6210: 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 .global x..set x
6220: 20 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 $args. }.
6230: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
6240: 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 a p} {expr 10 /
6250: 30 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 0}. set s [tl
6260: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6270: 72 20 61 63 63 65 70 74 20 32 38 34 38 5d 0a 20 r accept 2848].
6280: 20 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f puts $f hello
6290: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
62a0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
62b0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
62c0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
62d0: 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 vwait x. afte
62e0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
62f0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
6300: 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 rename bgerror
6310: 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b {}. set x.} {
6320: 7b 64 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d {divide by zero}
6330: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 37 2e }..test tlsIo-7.
6340: 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 1 {testing socke
6350: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
6360: 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ns} {socket stdi
6370: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
6380: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
6390: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
63a0: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
63b0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
63c0: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
63d0: 20 20 70 75 74 73 20 24 66 20 22 74 6c 73 3a 3a puts $f "tls::
63e0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
63f0: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
6400: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
6410: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
6420: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
6430: 32 38 32 30 22 0a 20 20 20 20 70 75 74 73 20 24 2820". puts $
6440: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
6450: 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f args {.. glo
6460: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
6470: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
6480: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
6490: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
64a0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
64b0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
64c0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
64d0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
64e0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
64f0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
6500: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
6510: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
6520: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
6530: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
6540: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
6550: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
6560: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6570: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
6580: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 127.0.0.1 28
6590: 32 30 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 20]. set p [f
65a0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 configure $s -pe
65b0: 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ername]. clos
65c0: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
65d0: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
65e0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
65f0: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 ring compare [li
6600: 6e 64 65 78 20 24 70 20 30 5d 20 31 32 37 2e 30 ndex $p 0] 127.0
6610: 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e .0.1]. lappen
6620: 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 d l [string comp
6630: 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 are [lindex $p 2
6640: 5d 20 32 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 ] 2820]. lapp
6650: 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 end l [llength $
6660: 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a 0a 74 65 p].} {0 0 3}..te
6670: 73 74 20 74 6c 73 49 6f 2d 37 2e 32 20 7b 74 65 st tlsIo-7.2 {te
6680: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
6690: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
66a0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
66b0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
66c0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
66d0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
66e0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
66f0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
6700: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
6710: 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 s $f "tls::socke
6720: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
6730: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
6740: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
6750: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6760: 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 31 22 $serverKey 2821"
6770: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
6780: 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 proc accept args
6790: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 {.. global x
67a0: 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 .. set x done
67b0: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
67c0: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
67d0: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
67e0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 imed_out"]..vwai
67f0: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
6800: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 l $timer. }.
6810: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6820: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
6830: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
6840: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
6850: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
6860: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6870: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
6880: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
6890: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
68a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
68b0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
68c0: 32 37 2e 30 2e 30 2e 31 20 32 38 32 31 5d 0a 20 27.0.0.1 2821].
68d0: 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 set p [fconfi
68e0: 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d gure $s -socknam
68f0: 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a e]. close $s.
6900: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
6910: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
6920: 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 ppend l [llength
6930: 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 $p]. lappend
6940: 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d l [lindex $p 0]
6950: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
6960: 73 74 72 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 string equal [li
6970: 6e 64 65 78 20 24 70 20 32 5d 20 32 38 32 31 5d ndex $p 2] 2821]
6980: 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 .} {3 127.0.0.1
6990: 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 37 0}..test tlsIo-7
69a0: 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .3 {testing sock
69b0: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
69c0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ons} {socket} {.
69d0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
69e0: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
69f0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
6a00: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
6a10: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
6a20: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 Key \. .-serv
6a30: 65 72 20 61 63 63 65 70 74 20 32 38 32 32 5d 0a er accept 2822].
6a40: 20 20 20 20 73 65 74 20 6c 20 5b 66 63 6f 6e 66 set l [fconf
6a50: 69 67 75 72 65 20 24 73 5d 0a 20 20 20 20 63 6c igure $s]. cl
6a60: 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 ose $s. updat
6a70: 65 0a 20 20 20 20 6c 6c 65 6e 67 74 68 20 24 6c e. llength $l
6a80: 0a 7d 20 31 32 0a 0a 74 65 73 74 20 74 6c 73 49 .} 12..test tlsI
6a90: 6f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 20 73 o-7.4 {testing s
6aa0: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
6ab0: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d ptions} {socket}
6ac0: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
6ad0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
6ae0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
6af0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6b00: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
6b10: 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 verKey \. .-s
6b20: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
6b30: 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 3]. proc acce
6b40: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
6b50: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
6b60: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
6b70: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
6b80: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
6b90: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
6ba0: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
6bb0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
6bc0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6bd0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
6be0: 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 .[info hostna
6bf0: 6d 65 5d 20 32 38 32 33 5d 0a 20 20 20 20 73 65 me] 2823]. se
6c00: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
6c10: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
6c20: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
6c30: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
6c40: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
6c50: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
6c60: 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c se $s1. set l
6c70: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
6c80: 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 l [lindex $x 2]
6c90: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
6ca0: 32 38 32 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 2823 3}..test tl
6cb0: 73 49 6f 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 sIo-7.5 {testing
6cc0: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
6cd0: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
6ce0: 74 20 75 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 t unixOrPc} {.
6cf0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6d00: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
6d10: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
6d20: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
6d30: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
6d40: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
6d50: 20 61 63 63 65 70 74 20 32 38 32 39 5d 0a 20 20 accept 2829].
6d60: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
6d70: 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 a p} {..global
6d80: 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 x..set x [fconfi
6d90: 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d gure $s -socknam
6da0: 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 e]..close $s.
6db0: 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 }. set s1 [t
6dc0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
6dd0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
6de0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
6df0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
6e00: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 31 ientKey \. .1
6e10: 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 5d 0a 20 27.0.0.1 2829].
6e20: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
6e30: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
6e40: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
6e50: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
6e60: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
6e70: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
6e80: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
6e90: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
6ea0: 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 pend l [lindex $
6eb0: 78 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 x 0] [lindex $x
6ec0: 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 2] [llength $x].
6ed0: 7d 20 7b 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 } {127.0.0.1 282
6ee0: 39 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f 9 3}..test tlsIo
6ef0: 2d 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 -8.1 {testing -a
6f00: 73 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 sync flag on soc
6f10: 6b 65 74 73 7d 20 7b 65 6d 70 74 79 20 73 6f 63 kets} {empty soc
6f20: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 74 65 73 ket} {. # tes
6f30: 74 20 73 65 65 6d 73 20 74 6f 20 68 61 6e 67 20 t seems to hang
6f40: 2d 2d 20 61 77 62 20 36 2f 32 2f 32 30 30 30 0a -- awb 6/2/2000.
6f50: 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 73 # NOTE: This
6f60: 20 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 6f test may fail o
6f70: 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 32 n some Solaris 2
6f80: 2e 34 20 73 79 73 74 65 6d 73 2e 20 49 66 20 69 .4 systems. If i
6f90: 74 20 64 6f 65 73 2c 0a 20 20 20 20 23 20 63 68 t does,. # ch
6fa0: 65 63 6b 20 74 68 61 74 20 79 6f 75 20 68 61 76 eck that you hav
6fb0: 65 20 74 68 65 73 65 20 70 61 74 63 68 65 73 20 e these patches
6fc0: 69 6e 73 74 61 6c 6c 65 64 20 28 75 73 69 6e 67 installed (using
6fd0: 20 73 68 6f 77 72 65 76 20 2d 70 29 3a 0a 20 20 showrev -p):.
6fe0: 20 20 23 0a 20 20 20 20 23 20 31 30 31 39 30 37 #. # 101907
6ff0: 2d 30 35 2c 20 31 30 31 39 32 35 2d 30 32 2c 20 -05, 101925-02,
7000: 31 30 31 39 34 35 2d 31 34 2c 20 31 30 31 39 35 101945-14, 10195
7010: 39 2d 30 33 2c 20 31 30 31 39 36 39 2d 30 35 2c 9-03, 101969-05,
7020: 20 31 30 31 39 37 33 2d 30 33 2c 0a 20 20 20 20 101973-03,.
7030: 23 20 31 30 31 39 37 37 2d 30 33 2c 20 31 30 31 # 101977-03, 101
7040: 39 38 31 2d 30 32 2c 20 31 30 31 39 38 35 2d 30 981-02, 101985-0
7050: 31 2c 20 31 30 32 30 30 31 2d 30 33 2c 20 31 30 1, 102001-03, 10
7060: 32 30 30 33 2d 30 31 2c 20 31 30 32 30 30 37 2d 2003-01, 102007-
7070: 30 31 2c 0a 20 20 20 20 23 20 31 30 32 30 31 31 01,. # 102011
7080: 2d 30 32 2c 20 31 30 32 30 32 34 2d 30 31 2c 20 -02, 102024-01,
7090: 31 30 32 30 33 39 2d 30 31 2c 20 31 30 32 30 34 102039-01, 10204
70a0: 34 2d 30 31 2c 20 31 30 32 30 34 38 2d 30 31 2c 4-01, 102048-01,
70b0: 20 31 30 32 30 36 32 2d 30 33 2c 0a 20 20 20 20 102062-03,.
70c0: 23 20 31 30 32 30 36 36 2d 30 34 2c 20 31 30 32 # 102066-04, 102
70d0: 30 37 30 2d 30 31 2c 20 31 30 32 31 30 35 2d 30 070-01, 102105-0
70e0: 31 2c 20 31 30 32 31 35 33 2d 30 33 2c 20 31 30 1, 102153-03, 10
70f0: 32 32 31 36 2d 30 31 2c 20 31 30 32 32 33 32 2d 2216-01, 102232-
7100: 30 31 2c 0a 20 20 20 20 23 20 31 30 31 38 37 38 01,. # 101878
7110: 2d 30 33 2c 20 31 30 31 38 37 39 2d 30 31 2c 20 -03, 101879-01,
7120: 31 30 31 38 38 30 2d 30 33 2c 20 31 30 31 39 33 101880-03, 10193
7130: 33 2d 30 31 2c 20 31 30 31 39 35 30 2d 30 31 2c 3-01, 101950-01,
7140: 20 31 30 32 30 33 30 2d 30 31 2c 0a 20 20 20 20 102030-01,.
7150: 23 20 31 30 32 30 35 37 2d 30 38 2c 20 31 30 32 # 102057-08, 102
7160: 31 34 30 2d 30 31 2c 20 31 30 31 39 32 30 2d 30 140-01, 101920-0
7170: 32 2c 20 31 30 31 39 32 31 2d 30 39 2c 20 31 30 2, 101921-09, 10
7180: 31 39 32 32 2d 30 37 2c 20 31 30 31 39 32 33 2d 1922-07, 101923-
7190: 30 33 0a 20 20 20 20 23 0a 20 20 20 20 23 20 49 03. #. # I
71a0: 66 20 61 66 74 65 72 20 69 6e 73 74 61 6c 6c 69 f after installi
71b0: 6e 67 20 74 68 65 73 65 20 70 61 74 63 68 65 73 ng these patches
71c0: 20 79 6f 75 20 61 72 65 20 73 74 69 6c 6c 20 65 you are still e
71d0: 78 70 65 72 69 65 6e 63 69 6e 67 20 61 0a 20 20 xperiencing a.
71e0: 20 20 23 20 70 72 6f 62 6c 65 6d 2c 20 70 6c 65 # problem, ple
71f0: 61 73 65 20 65 6d 61 69 6c 20 6a 79 6c 40 65 6e ase email jyl@en
7200: 67 2e 73 75 6e 2e 63 6f 6d 2e 20 57 65 20 68 61 g.sun.com. We ha
7210: 76 65 20 6e 6f 74 20 6f 62 73 65 72 76 65 64 20 ve not observed
7220: 74 68 69 73 0a 20 20 20 20 23 20 66 61 69 6c 75 this. # failu
7230: 72 65 20 6f 6e 20 53 6f 6c 61 72 69 73 20 32 2e re on Solaris 2.
7240: 35 2c 20 73 6f 20 61 6e 6f 74 68 65 72 20 6f 70 5, so another op
7250: 74 69 6f 6e 20 28 69 6e 73 74 65 61 64 20 6f 66 tion (instead of
7260: 20 69 6e 73 74 61 6c 6c 69 6e 67 0a 20 20 20 20 installing.
7270: 23 20 74 68 65 73 65 20 70 61 74 63 68 65 73 29 # these patches)
7280: 20 69 73 20 74 6f 20 75 70 67 72 61 64 65 20 74 is to upgrade t
7290: 6f 20 53 6f 6c 61 72 69 73 20 32 2e 35 2e 0a 20 o Solaris 2.5..
72a0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
72b0: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
72c0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
72d0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
72e0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
72f0: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
7300: 72 20 61 63 63 65 70 74 20 32 38 33 30 5d 0a 20 r accept 2830].
7310: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
7320: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
7330: 20 78 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a x..puts $s bye.
7340: 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 78 .close $s..set x
7350: 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 done. }.
7360: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
7370: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
7380: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
7390: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
73a0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
73b0: 20 5c 0a 09 2d 61 73 79 6e 63 20 5b 69 6e 66 6f \..-async [info
73c0: 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d hostname] 2830]
73d0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
73e0: 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 73 31 set z [gets $s1
73f0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
7400: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
7410: 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 65 set z.} bye..te
7420: 73 74 20 74 6c 73 49 6f 2d 39 2e 31 20 7b 74 65 st tlsIo-9.1 {te
7430: 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 sting spurious e
7440: 76 65 6e 74 73 7d 20 7b 65 6d 70 74 79 20 73 6f vents} {empty so
7450: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 6c 6f cket} {. # lo
7460: 63 6b 73 20 75 70 20 0a 20 20 20 20 73 65 74 20 cks up . set
7470: 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 len 0. set sp
7480: 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 urious 0. set
7490: 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 done 0. proc
74a0: 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 readlittle {s}
74b0: 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f {..global spurio
74c0: 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 us done len..set
74d0: 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 l [read $s 1]..
74e0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 if {[string leng
74f0: 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 th $l] == 0} {..
7500: 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 if {![eof $s
7510: 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 ]} {...incr spur
7520: 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 ious.. } else
7530: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 {...close $s...
7540: 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 set done 1..
7550: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 }..} else {..
7560: 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e incr len [strin
7570: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a g length $l]..}.
7580: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 }. proc a
7590: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
75a0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
75b0: 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 20 2d buffering none -
75c0: 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 66 69 blocking off..fi
75d0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
75e0: 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 ble [list readli
75f0: 74 74 6c 65 20 24 73 5d 0a 20 20 20 20 7d 0a 20 ttle $s]. }.
7600: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
7610: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
7620: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
7630: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7640: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
7650: 65 79 20 5c 0a 20 20 20 09 2d 73 65 72 76 65 72 ey \. .-server
7660: 20 61 63 63 65 70 74 20 32 38 33 31 5d 0a 20 20 accept 2831].
7670: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
7680: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
7690: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
76a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
76b0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
76c0: 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 y \. .[info h
76d0: 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 5d 0a 20 ostname] 2831].
76e0: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
76f0: 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 38 39 ne $c 0123456789
7700: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 0123456789012345
7710: 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 6789012345678901
7720: 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 23456789. clo
7730: 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 74 69 se $c. set ti
7740: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
7750: 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 "set done timed
7760: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
7770: 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 done. after
7780: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
7790: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c close $s. l
77a0: 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c ist $spurious $l
77b0: 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 en.} {0 50}..tes
77c0: 74 20 74 6c 73 49 6f 2d 39 2e 32 20 7b 74 65 73 t tlsIo-9.2 {tes
77d0: 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 ting async write
77e0: 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c , fileevents, fl
77f0: 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 ush on close} {s
7800: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
7810: 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a 20 firstblock "".
7820: 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d for {set i 0}
7830: 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 20 {$i < 5} {incr
7840: 69 7d 20 7b 73 65 74 20 66 69 72 73 74 62 6c 6f i} {set firstblo
7850: 63 6b 20 22 61 24 66 69 72 73 74 62 6c 6f 63 6b ck "a$firstblock
7860: 24 66 69 72 73 74 62 6c 6f 63 6b 22 7d 0a 20 20 $firstblock"}.
7870: 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 set secondbloc
7880: 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 k "". for {se
7890: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d t i 0} {$i < 16}
78a0: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 73 65 74 {incr i} {..set
78b0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 secondblock "b$
78c0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f secondblock$seco
78d0: 6e 64 62 6c 6f 63 6b 22 0a 20 20 20 20 7d 0a 20 ndblock". }.
78e0: 20 20 20 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 set l [tls::s
78f0: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
7900: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
7910: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7920: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
7930: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
7940: 72 20 61 63 63 65 70 74 20 32 38 33 32 5d 0a 20 r accept 2832].
7950: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
7960: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
7970: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
7980: 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e g 0 -translation
7990: 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 lf -buffersize
79a0: 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 16384 \...-buffe
79b0: 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 ring line..filee
79c0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
79d0: 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 20 "readable $s".
79e0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
79f0: 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 adable {s} {..se
7a00: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 66 t l [gets $s]..f
7a10: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
7a20: 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 able {}..after 1
7a30: 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 000 respond $s.
7a40: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
7a50: 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f spond {s} {..glo
7a60: 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 bal firstblock..
7a70: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
7a80: 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 $s $firstblock..
7a90: 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 65 after 1000 write
7aa0: 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 data $s. }.
7ab0: 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 proc writedata
7ac0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 {s} {..global s
7ad0: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 74 73 econdblock..puts
7ae0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
7af0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f secondblock..clo
7b00: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
7b10: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
7b20: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
7b30: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
7b40: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7b50: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
7b60: 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 \. .[info hos
7b70: 74 6e 61 6d 65 5d 20 32 38 33 32 5d 0a 20 20 20 tname] 2832].
7b80: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
7b90: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
7ba0: 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 s lf -buffering
7bb0: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 line. set cou
7bc0: 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 nt 0. puts $s
7bd0: 20 68 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 hello. proc
7be0: 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c readit {s} {..gl
7bf0: 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a obal count done.
7c00: 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d .set l [read $s]
7c10: 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 ..incr count [st
7c20: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
7c30: 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b .if {[eof $s]} {
7c40: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
7c50: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 set done 1..
7c60: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 }. }. file
7c70: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
7c80: 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 e "readit $s".
7c90: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
7ca0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f er 10000 "set do
7cb0: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 ne timed_out"].
7cc0: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
7cd0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
7ce0: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
7cf0: 24 6c 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 $l. set count
7d00: 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 74 .} 65566..test t
7d10: 6c 73 49 6f 2d 39 2e 33 20 7b 74 65 73 74 69 6e lsIo-9.3 {testin
7d20: 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 g EOF stickyness
7d30: 7d 20 7b 65 6d 70 74 79 20 73 6f 63 6b 65 74 7d } {empty socket}
7d40: 20 7b 0a 20 20 20 20 23 20 68 61 6e 67 73 0a 20 {. # hangs.
7d50: 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 74 6f proc count_to
7d60: 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 _eof {s} {..glob
7d70: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 20 74 69 al count done ti
7d80: 6d 65 72 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 mer..set l [gets
7d90: 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 $s]..if {[eof $
7da0: 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 s]} {.. incr
7db0: 63 6f 75 6e 74 0a 09 20 20 20 20 69 66 20 7b 24 count.. if {$
7dc0: 63 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 63 count > 9} {...c
7dd0: 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f lose $s...set do
7de0: 6e 65 20 74 72 75 65 0a 09 09 73 65 74 20 63 6f ne true...set co
7df0: 75 6e 74 20 7b 65 6f 66 20 69 73 20 73 74 69 63 unt {eof is stic
7e00: 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 ky}...after canc
7e10: 65 6c 20 24 74 69 6d 65 72 0a 09 20 20 20 20 7d el $timer.. }
7e20: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ..}. }. pr
7e30: 6f 63 20 74 69 6d 65 72 70 72 6f 63 20 7b 7d 20 oc timerproc {}
7e40: 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 {..global done c
7e50: 6f 75 6e 74 20 63 0a 09 73 65 74 20 64 6f 6e 65 ount c..set done
7e60: 20 74 72 75 65 0a 09 73 65 74 20 63 6f 75 6e 74 true..set count
7e70: 20 7b 74 69 6d 65 72 20 77 65 6e 74 20 6f 66 66 {timer went off
7e80: 2c 20 65 6f 66 20 69 73 20 6e 6f 74 20 73 74 69 , eof is not sti
7e90: 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 cky}..close $c.
7ea0: 20 20 20 7d 09 0a 20 20 20 20 73 65 74 20 63 6f }.. set co
7eb0: 75 6e 74 20 30 0a 20 20 20 20 73 65 74 20 64 6f unt 0. set do
7ec0: 6e 65 20 66 61 6c 73 65 0a 20 20 20 20 70 72 6f ne false. pro
7ed0: 63 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f c write_then_clo
7ee0: 73 65 20 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 se {s} {..puts $
7ef0: 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a s bye..close $s.
7f00: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 }. proc a
7f10: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
7f20: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
7f30: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
7f40: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 09 translation lf..
7f50: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 fileevent $s wri
7f60: 74 61 62 6c 65 20 22 77 72 69 74 65 5f 74 68 65 table "write_the
7f70: 6e 5f 63 6c 6f 73 65 20 24 73 22 0a 20 20 20 20 n_close $s".
7f80: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
7f90: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
7fa0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
7fb0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7fc0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
7fd0: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
7fe0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 33 rver accept 2833
7ff0: 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 ]. set c [tls
8000: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
8010: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
8020: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8030: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
8040: 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 5b 69 6e ntKey \. .[in
8050: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 fo hostname] 283
8060: 33 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 3]. fconfigur
8070: 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f e $c -blocking o
8080: 66 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 ff -buffering li
8090: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
80a0: 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 lf. fileevent
80b0: 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f $c readable "co
80c0: 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 unt_to_eof $c".
80d0: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
80e0: 74 65 72 20 31 30 30 30 20 74 69 6d 65 72 70 72 ter 1000 timerpr
80f0: 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f oc]. vwait do
8100: 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a ne. close $s.
8110: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 set count.}
8120: 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a {eof is sticky}.
8130: 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 .removeFile scri
8140: 70 74 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 pt..test tlsIo-1
8150: 30 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 0.1 {testing soc
8160: 6b 65 74 20 61 63 63 65 70 74 20 63 61 6c 6c 62 ket accept callb
8170: 61 63 6b 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 ack error handli
8180: 6e 67 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ng} {socket} {.
8190: 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 set goterror
81a0: 30 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 0. proc bgerr
81b0: 6f 72 20 61 72 67 73 20 7b 67 6c 6f 62 61 6c 20 or args {global
81c0: 67 6f 74 65 72 72 6f 72 3b 20 73 65 74 20 67 6f goterror; set go
81d0: 74 65 72 72 6f 72 20 31 7d 0a 20 20 20 20 73 65 terror 1}. se
81e0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
81f0: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \..-certfile $s
8200: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
8210: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8220: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8230: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
8240: 65 70 74 20 32 38 39 38 5d 0a 20 20 20 20 70 72 ept 2898]. pr
8250: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
8260: 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 72 72 } {close $s; err
8270: 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 or}. set c [t
8280: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
8290: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
82a0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
82b0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
82c0: 69 65 6e 74 4b 65 79 20 5c 0a 09 31 32 37 2e 30 ientKey \..127.0
82d0: 2e 30 2e 31 20 32 38 39 38 5d 0a 20 20 20 20 76 .0.1 2898]. v
82e0: 77 61 69 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 wait goterror.
82f0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
8300: 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 lose $c. set
8310: 67 6f 74 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 goterror.} 1..te
8320: 73 74 20 74 6c 73 49 6f 2d 31 31 2e 31 20 7b 74 st tlsIo-11.1 {t
8330: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b cp connection} {
8340: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8350: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
8360: 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e {. sendComman
8370: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
8380: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
8390: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
83a0: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
83b0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
83c0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
83d0: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
83e0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
83f0: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
8400: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
8410: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8420: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
8430: 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 ntKey". sendC
8440: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
8450: 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 cket9_1_test_ser
8460: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
8470: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
8480: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
8490: 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 erverCert \...-c
84a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
84b0: 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 ..-keyfile $serv
84c0: 65 72 4b 65 79 20 5c 0a 09 09 32 38 33 34 5d 0a erKey \...2834].
84d0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
84e0: 61 20 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 a p} {.. puts
84f0: 20 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 74 6c $s done.. tl
8500: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
8510: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d . close $s..}
8520: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
8530: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8540: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
8550: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
8560: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
8570: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
8580: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
8590: 76 65 72 49 50 20 32 38 33 34 5d 0a 20 20 20 20 verIP 2834].
85a0: 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a set r [gets $s].
85b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
85c0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
85d0: 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 ose $socket9_1_t
85e0: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
85f0: 73 65 74 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 65 set r.} done..te
8600: 73 74 20 74 6c 73 49 6f 2d 31 31 2e 32 20 7b 63 st tlsIo-11.2 {c
8610: 6c 69 65 6e 74 20 73 70 65 63 69 66 69 65 73 20 lient specifies
8620: 69 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 its port} {socke
8630: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
8640: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
8650: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
8660: 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 t caCert $caCert
8670: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
8680: 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 d "set serverCer
8690: 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 t $serverCert".
86a0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
86b0: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 set clientCert $
86c0: 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 clientCert".
86d0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
86e0: 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 serverKey $serv
86f0: 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 erKey". sendC
8700: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
8710: 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 ntKey $clientKey
8720: 22 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 ". if {[info
8730: 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a exists port]} {.
8740: 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d .incr port. }
8750: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 else {..set por
8760: 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b 20 5b t [expr 2048 + [
8770: 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 20 7d pid]%1024]. }
8780: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8790: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f {..set socket9_
87a0: 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 2_test_server [t
87b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
87c0: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 er accept \...-c
87d0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
87e0: 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 ert \...-cafile
87f0: 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 $caCert \...-key
8800: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8810: 5c 0a 09 20 20 20 20 32 38 33 35 5d 0a 09 70 72 \.. 2835]..pr
8820: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
8830: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
8840: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
8850: 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 20 20 puts $s $p..
8860: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
8870: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
8880: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
8890: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
88a0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
88b0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
88c0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
88d0: 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 24 -myport $port $
88e0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
88f0: 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 835]. set r [
8900: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f gets $s]. clo
8910: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
8920: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
8930: 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 cket9_2_test_ser
8940: 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 72 20 ver}. if {$r
8950: 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 65 74 == $port} {..set
8960: 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 20 7d result ok. }
8970: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 else {..set res
8980: 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 20 7d ult broken. }
8990: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
89a0: 7d 20 6f 6b 0a 74 65 73 74 20 74 6c 73 49 6f 2d } ok.test tlsIo-
89b0: 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 6f 20 11.3 {trying to
89c0: 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 72 76 connect, no serv
89d0: 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 er} {socket doTe
89e0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
89f0: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ver} {. set s
8a00: 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 tatus ok. if
8a10: 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 20 {![catch {set s
8a20: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
8a30: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
8a40: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
8a50: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8a60: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
8a70: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
8a80: 65 72 49 70 20 32 38 33 36 5d 7d 5d 7d 20 7b 0a erIp 2836]}]} {.
8a90: 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 .if {![catch {ge
8aa0: 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 ts $s}]} {..
8ab0: 73 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 set status broke
8ac0: 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 n..}..close $s.
8ad0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 }. set sta
8ae0: 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 tus.} ok..test t
8af0: 6c 73 49 6f 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 lsIo-11.4 {remot
8b00: 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 e echo, one line
8b10: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
8b20: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
8b30: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d r} {. sendCom
8b40: 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 mand "set caCert
8b50: 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 $caCert". se
8b60: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
8b70: 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 erverCert $serve
8b80: 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 rCert". sendC
8b90: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
8ba0: 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 ntCert $clientCe
8bb0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8bc0: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b and "set serverK
8bd0: 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 ey $serverKey".
8be0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8bf0: 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 set clientKey $c
8c00: 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 lientKey". se
8c10: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 20 20 20 20 ndCommand {.
8c20: 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 43 65 .global serverCe
8c30: 72 74 0a 09 67 6c 6f 62 61 6c 20 63 61 43 65 72 rt..global caCer
8c40: 74 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 t..global server
8c50: 4b 65 79 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 Key..set socket1
8c60: 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 20 0_6_test_server
8c70: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
8c80: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
8c90: 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 erCert \...-cafi
8ca0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d le $caCert \...-
8cb0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8cc0: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
8cd0: 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f ccept 2836]..pro
8ce0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
8cf0: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
8d00: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 dshake $s.. f
8d10: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
8d20: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
8d30: 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 $s].. fconfig
8d40: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
8d50: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
8d60: 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f ion crlf..}..pro
8d70: 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 c echo {s} {..
8d80: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
8d90: 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 ].. if {[eof
8da0: 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 $s]} {...close $
8db0: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
8dc0: 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 ..puts $s $l..
8dd0: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
8de0: 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 set f [tls::soc
8df0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
8e00: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
8e10: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8e20: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
8e30: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
8e40: 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 oteServerIP 2836
8e50: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
8e60: 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e $f -translation
8e70: 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 crlf -buffering
8e80: 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 20 24 line. puts $
8e90: 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 74 20 f hello. set
8ea0: 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 r [gets $f].
8eb0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e close $f. sen
8ec0: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
8ed0: 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 $socket10_6_test
8ee0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
8ef0: 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 73 74 r.} hello..test
8f00: 20 74 6c 73 49 6f 2d 31 31 2e 35 20 7b 72 65 6d tlsIo-11.5 {rem
8f10: 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 6e ote echo, 50 lin
8f20: 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 es} {socket doTe
8f30: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
8f40: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
8f50: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 ommand "set caCe
8f60: 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 rt $caCert".
8f70: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8f80: 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 serverCert $ser
8f90: 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e verCert". sen
8fa0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
8fb0: 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 ientCert $client
8fc0: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
8fd0: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
8fe0: 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 rKey $serverKey"
8ff0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9000: 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 "set clientKey
9010: 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 $clientKey".
9020: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
9030: 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 et socket10_7_te
9040: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
9050: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
9060: 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 ccept \...-certf
9070: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
9080: 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 \...-cafile $caC
9090: 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 ert \...-keyfile
90a0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 $serverKey \...
90b0: 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 2836]..proc acce
90c0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
90d0: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
90e0: 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 65 $s.. fileeve
90f0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
9100: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 list echo $s]..
9110: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
9120: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
9130: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 -translation cr
9140: 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f lf..}..proc echo
9150: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 {s} {.. set
9160: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 l [gets $s]..
9170: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
9180: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 ...close $s..
9190: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 } else {...puts
91a0: 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d $s $l.. }..}
91b0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 . }. set f
91c0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
91d0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
91e0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
91f0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9200: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
9210: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
9220: 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 verIP 2836].
9230: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 74 fconfigure $f -t
9240: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 ranslation crlf
9250: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
9260: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 for {set cnt
9270: 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 0} {$cnt < 50}
9280: 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 {incr cnt} {..pu
9290: 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 ts $f "hello, $c
92a0: 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 nt"..if {[string
92b0: 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 73 20 24 compare [gets $
92c0: 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 f] "hello, $cnt"
92d0: 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 ] != 0} {.. b
92e0: 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 reak..}. }.
92f0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
9300: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
9310: 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 e $socket10_7_te
9320: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
9330: 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d et cnt.} 50..# M
9340: 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 acintosh sockets
9350: 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 can have more t
9360: 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 20 70 han one server p
9370: 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c er port.if {$tcl
9380: 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f _platform(platfo
9390: 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 rm) == "macintos
93a0: 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f h"} {. set co
93b0: 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 30 20 nflictResult {0
93c0: 32 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 2836}.} else {.
93d0: 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 set conflictR
93e0: 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e esult {1 {couldn
93f0: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
9400: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
9410: 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 in use}}.}..test
9420: 20 74 6c 73 49 6f 2d 31 31 2e 36 20 7b 73 6f 63 tlsIo-11.6 {soc
9430: 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 ket conflict} {s
9440: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9450: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9460: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
9470: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9480: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
9490: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
94a0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
94b0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
94c0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
94d0: 32 38 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 2836]. if {[c
94e0: 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b 74 6c atch {set s2 [tl
94f0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9500: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
9510: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
9520: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9530: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
9540: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
9550: 20 32 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 2836]} msg]} {.
9560: 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 .set result [lis
9570: 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 t 1 $msg]. }
9580: 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 else {..set resu
9590: 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 lt [list 0 [lind
95a0: 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 ex [fconfigure $
95b0: 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d s2 -sockname] 2]
95c0: 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 ]..close $s2.
95d0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 }. close $s1
95e0: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
95f0: 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c } $conflictResul
9600: 74 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 31 t..test tlsIo-11
9610: 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 .7 {server with
9620: 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d several clients}
9630: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
9640: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
9650: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d } {. sendComm
9660: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
9670: 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 t10_9_test_serve
9680: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
9690: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 ...-certfile [fi
96a0: 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 le join [pwd] ce
96b0: 72 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 rts server.pem]
96c0: 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c \...-cafile [fil
96d0: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
96e0: 74 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c ts caFile.pem] \
96f0: 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c ...-keyfile [fil
9700: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
9710: 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 ts skey.pem] \..
9720: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
9730: 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 2836]..proc acce
9740: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
9750: 20 20 23 20 68 61 6e 64 73 68 61 6b 65 20 6c 6f # handshake lo
9760: 63 6b 73 20 75 70 20 74 68 65 20 74 68 72 65 65 cks up the three
9770: 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 63 6c 69 synchronous cli
9780: 65 6e 74 73 0a 09 20 20 20 20 23 20 74 6c 73 3a ents.. # tls:
9790: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
97a0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
97b0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
97c0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
97d0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
97e0: 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 t echo $s]..}..p
97f0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
9800: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
9810: 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f $s].. if {[eo
9820: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
9830: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 $s.. } else
9840: 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 {...puts $s $l..
9850: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
9860: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
9870: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9880: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9890: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
98a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
98b0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
98c0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
98d0: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
98e0: 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 ure $s1 -bufferi
98f0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
9900: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
9910: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9920: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9930: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9940: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9950: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9960: 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 erverIP 2836].
9970: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 fconfigure $s2
9980: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
9990: 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 . set s3 [tls
99a0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
99b0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
99c0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
99d0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
99e0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
99f0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9a00: 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 2836]. fconf
9a10: 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 igure $s3 -buffe
9a20: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f ring line. fo
9a30: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
9a40: 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 < 100} {incr i}
9a50: 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c {..puts $s1 hell
9a60: 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 o,s1..gets $s1..
9a70: 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 puts $s2 hello,s
9a80: 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 2..gets $s2..put
9a90: 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 s $s3 hello,s3..
9aa0: 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 gets $s3. }.
9ab0: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
9ac0: 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 close $s2. c
9ad0: 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e lose $s3. sen
9ae0: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
9af0: 24 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 $socket10_9_test
9b00: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
9b10: 20 69 0a 7d 20 31 30 30 20 20 20 20 0a 0a 74 65 i.} 100 ..te
9b20: 73 74 20 74 6c 73 49 6f 2d 31 31 2e 38 20 7b 63 st tlsIo-11.8 {c
9b30: 6c 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 lient with sever
9b40: 61 6c 20 73 65 72 76 65 72 73 7d 20 7b 65 6d 70 al servers} {emp
9b50: 74 79 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 ty socket doTest
9b60: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9b70: 72 7d 20 7b 0a 20 20 20 20 23 20 74 68 69 73 20 r} {. # this
9b80: 6f 6e 65 20 73 65 65 6d 73 20 74 6f 20 68 61 6e one seems to han
9b90: 67 20 2d 2d 20 61 77 62 20 36 2f 32 2f 32 30 30 g -- awb 6/2/200
9ba0: 30 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 0. sendComman
9bb0: 64 20 7b 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 d {..set s1 [tls
9bc0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 ::socket \...-ce
9bd0: 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 rtfile [file joi
9be0: 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 65 n [pwd] certs se
9bf0: 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 rver.pem] \...-c
9c00: 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e afile [file join
9c10: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 46 [pwd] certs caF
9c20: 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 ile.pem] \...-ke
9c30: 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e yfile [file join
9c40: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b 65 [pwd] certs ske
9c50: 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 y.pem] \...-serv
9c60: 65 72 20 22 61 63 63 65 70 74 20 34 30 30 33 22 er "accept 4003"
9c70: 20 34 30 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 4003]..set s2 [
9c80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
9c90: 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 -certfile [file
9ca0: 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 join [pwd] certs
9cb0: 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 server.pem] \..
9cc0: 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a .-cafile [file j
9cd0: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9ce0: 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 caFile.pem] \...
9cf0: 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a -keyfile [file j
9d00: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9d10: 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 skey.pem] \...-s
9d20: 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 erver "accept 40
9d30: 30 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 73 04" 4004]..set s
9d40: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 3 [tls::socket \
9d50: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 ...-certfile [fi
9d60: 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 le join [pwd] ce
9d70: 72 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 rts server.pem]
9d80: 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c \...-cafile [fil
9d90: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
9da0: 74 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c ts caFile.pem] \
9db0: 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c ...-keyfile [fil
9dc0: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
9dd0: 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 ts skey.pem] \..
9de0: 09 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 .-server "accept
9df0: 20 34 30 30 35 22 20 34 30 30 35 5d 0a 09 70 72 4005" 4005]..pr
9e00: 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 20 73 20 oc accept {mp s
9e10: 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a a p} {.. tls:
9e20: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
9e30: 20 20 20 70 75 74 73 20 24 73 20 24 6d 70 0a 09 puts $s $mp..
9e40: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
9e50: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
9e60: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9e70: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9e80: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
9e90: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9ea0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
9eb0: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
9ec0: 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 20 20 verIP 4003].
9ed0: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
9ee0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
9ef0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
9f00: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9f10: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
9f20: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
9f30: 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 34 oteServerIP 4004
9f40: 5d 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c ]. set s3 [tl
9f50: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9f60: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
9f70: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
9f80: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9f90: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
9fa0: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
9fb0: 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 74 20 P 4005]. set
9fc0: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
9fd0: 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 67 l [gets $s1] [g
9fe0: 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 24 73 ets $s1] [eof $s
9ff0: 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 67 1] [gets $s2] [g
a000: 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 24 73 ets $s2] [eof $s
a010: 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 33 5d 2] \..[gets $s3]
a020: 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 6f 66 [gets $s3] [eof
a030: 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s3]. close
a040: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
a050: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
a060: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a070: 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 63 6c {..close $s1..cl
a080: 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 20 24 ose $s2..close $
a090: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s3. }. set
a0a0: 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 31 20 l.} {4003 {} 1
a0b0: 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 20 7b 4004 {} 1 4005 {
a0c0: 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f } 1}..test tlsIo
a0d0: 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 63 61 -11.9 {accept ca
a0e0: 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 llback error} {s
a0f0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
a100: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
a110: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
a120: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
a130: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
a140: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
a150: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
a160: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
a170: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
a180: 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 836]. proc ac
a190: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 cept {s a p} {ex
a1a0: 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 70 pr 10 / 0}. p
a1b0: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 roc bgerror args
a1c0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
a1d0: 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d 0a t x $args. }.
a1e0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a1f0: 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 "set caCert $caC
a200: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a210: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
a220: 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 Cert $serverCert
a230: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a240: 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 d "set clientCer
a250: 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 t $clientCert".
a260: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a270: 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 set serverKey $s
a280: 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 erverKey". se
a290: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
a2a0: 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 lientKey $client
a2b0: 4b 65 79 22 0a 20 20 20 20 69 66 20 7b 5b 63 61 Key". if {[ca
a2c0: 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 tch {sendCommand
a2d0: 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 65 72 {.. set peer
a2e0: 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 65 name [fconfigure
a2f0: 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 2d $callerSocket -
a300: 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 73 peername].. s
a310: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
a320: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
a330: 24 63 6c 69 65 6e 74 43 65 72 74 20 5c 0a 09 09 $clientCert \...
a340: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a350: 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \...-keyfile $cl
a360: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 09 ientKey \.. .
a370: 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 6e 61 6d [lindex $peernam
a380: 65 20 30 5d 20 32 38 33 36 5d 0a 09 20 20 20 20 e 0] 2836]..
a390: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 20 7d close $s. . }
a3a0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 } msg]} {..close
a3b0: 20 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 67 0a $s..error $msg.
a3c0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 69 }. set ti
a3d0: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
a3e0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
a3f0: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
a400: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
a410: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
a420: 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 e $s. rename
a430: 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 bgerror {}. s
a440: 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 et x.} {{divide
a450: 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 by zero}}..test
a460: 74 6c 73 49 6f 2d 31 31 2e 31 30 20 7b 74 65 73 tlsIo-11.10 {tes
a470: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
a480: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 ific options} {s
a490: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
a4a0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
a4b0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a4c0: 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 "set caCert $ca
a4d0: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
a4e0: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
a4f0: 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 rCert $serverCer
a500: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
a510: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 nd "set clientCe
a520: 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a rt $clientCert".
a530: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a540: 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 "set serverKey $
a550: 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 serverKey". s
a560: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
a570: 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e clientKey $clien
a580: 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f tKey". sendCo
a590: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
a5a0: 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 ket10_12_test_se
a5b0: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
a5c0: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
a5d0: 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 $serverCert \...
a5e0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a5f0: 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 \...-keyfile $se
a600: 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 rverKey \...-ser
a610: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d ver accept 2836]
a620: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
a630: 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 7d a p} {close $s}
a640: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
a650: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
a660: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
a670: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
a680: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
a690: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
a6a0: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
a6b0: 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 verIP 2836].
a6c0: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
a6d0: 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a e $s -peername].
a6e0: 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f 6e 66 set n [fconf
a6f0: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
a700: 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 me]. set l ""
a710: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
a720: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b 6c 6c lindex $p 2] [ll
a730: 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 ength $p] [lleng
a740: 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f 73 65 th $p]. close
a750: 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s. sendComm
a760: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
a770: 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 et10_12_test_ser
a780: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d ver}. set l.}
a790: 20 7b 32 38 33 36 20 33 20 33 7d 0a 0a 74 65 73 {2836 3 3}..tes
a7a0: 74 20 74 6c 73 49 6f 2d 31 31 2e 31 31 20 7b 74 t tlsIo-11.11 {t
a7b0: 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 esting spurious
a7c0: 65 76 65 6e 74 73 7d 20 7b 65 6d 70 74 79 20 73 events} {empty s
a7d0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
a7e0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
a7f0: 0a 20 20 20 20 23 20 68 61 6e 67 73 0a 20 20 20 . # hangs.
a800: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
a810: 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 t caCert $caCert
a820: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a830: 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 d "set serverCer
a840: 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 t $serverCert".
a850: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a860: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 set clientCert $
a870: 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 clientCert".
a880: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a890: 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 serverKey $serv
a8a0: 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 erKey". sendC
a8b0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
a8c0: 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 ntKey $clientKey
a8d0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a8e0: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
a8f0: 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 65 72 0_13_test_server
a900: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
a910: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
a920: 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 verCert \...-caf
a930: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 ile $caCert \...
a940: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
a950: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
a960: 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 accept 2836]..pr
a970: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
a980: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
a990: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
a9a0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
a9b0: 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f ranslation "auto
a9c0: 20 6c 66 22 0a 09 20 20 20 20 61 66 74 65 72 20 lf".. after
a9d0: 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 24 73 100 writesome $s
a9e0: 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 73 ..}..proc writes
a9f0: 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 66 ome {s} {.. f
aa00: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
aa10: 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d < 100} {incr i}
aa20: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 6c 69 {...puts $s "li
aa30: 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f 74 ne $i from remot
aa40: 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 20 7d e server".. }
aa50: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
aa60: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
aa70: 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 len 0. set sp
aa80: 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 urious 0. set
aa90: 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 done 0. proc
aaa0: 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 readlittle {s}
aab0: 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f {..global spurio
aac0: 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 us done len..set
aad0: 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 l [read $s 1]..
aae0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 if {[string leng
aaf0: 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 th $l] == 0} {..
ab00: 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 if {![eof $s
ab10: 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 ]} {...incr spur
ab20: 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 ious.. } else
ab30: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 {...close $s...
ab40: 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 set done 1..
ab50: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 }..} else {..
ab60: 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e incr len [strin
ab70: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a g length $l]..}.
ab80: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 }. set c
ab90: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
aba0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
abb0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
abc0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
abd0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
abe0: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
abf0: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 erIP 2836]. f
ac00: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
ac10: 61 62 6c 65 20 22 72 65 61 64 6c 69 74 74 6c 65 able "readlittle
ac20: 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d $c". set tim
ac30: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
ac40: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
ac50: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
ac60: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
ac70: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
ac80: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
ac90: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 33 ose $socket10_13
aca0: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
acb0: 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 list $spurious
acc0: 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d $len.} {0 2690}
acd0: 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 31 31 2e ..test tlsIo-11.
ace0: 31 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 12 {testing EOF
acf0: 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 73 6f 63 stickyness} {soc
ad00: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
ad10: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
ad20: 20 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 30 set counter 0
ad30: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
ad40: 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 proc count_u
ad50: 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 p {s} {..global
ad60: 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 counter done aft
ad70: 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 er_id..set l [ge
ad80: 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 ts $s]..if {[eof
ad90: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 $s]} {.. inc
ada0: 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 r counter.. i
adb0: 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d f {$counter > 9}
adc0: 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 {...set done {E
add0: 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 OF is sticky}...
ade0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 66 after cancel $af
adf0: 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 ter_id...close $
ae00: 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 s.. }..}.
ae10: 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 64 }. proc timed
ae20: 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 _out {} {..globa
ae30: 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f l c done..set do
ae40: 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 ne {timed_out, E
ae50: 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 OF is not sticky
ae60: 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 }..close $c.
ae70: 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e }. sendComman
ae80: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
ae90: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
aea0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
aeb0: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
aec0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
aed0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
aee0: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
aef0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
af00: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
af10: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
af20: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
af30: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
af40: 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 ntKey". sendC
af50: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
af60: 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 cket10_14_test_s
af70: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
af80: 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 et \...-certfile
af90: 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 $serverCert \..
afa0: 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 .-cafile $caCert
afb0: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 \...-keyfile $s
afc0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 erverKey \...-se
afd0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
afe0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
aff0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
b000: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
b010: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 20 63 . after 100 c
b020: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
b030: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
b040: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
b050: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
b060: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b070: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
b080: 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 lientKey \. .
b090: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
b0a0: 32 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 76 2836]. fileev
b0b0: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
b0c0: 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a 20 20 "count_up $c".
b0d0: 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 20 5b set after_id [
b0e0: 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 64 after 1000 timed
b0f0: 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 20 _out]. vwait
b100: 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 6f 6d done. sendCom
b110: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
b120: 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 ket10_14_test_se
b130: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 64 6f rver}. set do
b140: 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 74 69 ne.} {EOF is sti
b150: 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f cky}..test tlsIo
b160: 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e 67 20 -11.13 {testing
b170: 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 73 79 async write, asy
b180: 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e 63 20 nc flush, async
b190: 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65 close} \..{socke
b1a0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
b1b0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
b1c0: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
b1d0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
b1e0: 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 done..set l [re
b1f0: 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 ad $s]..incr cou
b200: 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 nt [string lengt
b210: 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 h $l]..if {[eof
b220: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 $s]} {.. clos
b230: 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f e $s.. set do
b240: 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 ne 1..}. }.
b250: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
b260: 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 et caCert $caCer
b270: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
b280: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 nd "set serverCe
b290: 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a rt $serverCert".
b2a0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b2b0: 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 "set clientCert
b2c0: 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 $clientCert".
b2d0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
b2e0: 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 t serverKey $ser
b2f0: 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 verKey". send
b300: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
b310: 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 entKey $clientKe
b320: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
b330: 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 nd {..set firstb
b340: 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 lock ""..for {se
b350: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 t i 0} {$i < 5}
b360: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 73 65 74 {incr i} {...set
b370: 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 firstblock "a$f
b380: 69 72 73 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 irstblock$firstb
b390: 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 73 65 lock"..}..set se
b3a0: 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a 09 66 6f condblock ""..fo
b3b0: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
b3c0: 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b < 16} {incr i} {
b3d0: 0a 09 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 .. set second
b3e0: 62 6c 6f 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 block "b$secondb
b3f0: 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b lock$secondblock
b400: 22 0a 09 7d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 "..}..set l [tls
b410: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 ::socket \...-ce
b420: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
b430: 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 rt \...-cafile $
b440: 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 caCert \...-keyf
b450: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
b460: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
b470: 74 20 32 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 t 2845]..proc ac
b480: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
b490: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
b4a0: 6b 65 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 ke $s.. fconf
b4b0: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
b4c0: 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f ng 0 -translatio
b4d0: 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 n lf -buffersize
b4e0: 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 16384 \...-buff
b4f0: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 ering line..
b500: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
b510: 64 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 dable "readable
b520: 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 65 61 $s"..}..proc rea
b530: 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 20 dable {s} {..
b540: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
b550: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
b560: 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 $s readable {}..
b570: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 72 after 1000 r
b580: 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 72 espond $s..}..pr
b590: 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b oc respond {s} {
b5a0: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 69 72 .. global fir
b5b0: 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 stblock.. put
b5c0: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 s -nonewline $s
b5d0: 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 $firstblock..
b5e0: 20 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 after 1000 writ
b5f0: 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 72 6f edata $s..}..pro
b600: 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 c writedata {s}
b610: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 65 {.. global se
b620: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 70 condblock.. p
b630: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
b640: 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 s $secondblock..
b650: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
b660: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
b670: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
b680: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
b690: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
b6a0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b6b0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
b6c0: 20 20 20 20 09 24 72 65 6d 6f 74 65 53 65 72 76 .$remoteServ
b6d0: 65 72 49 50 20 32 38 34 35 5d 0a 20 20 20 20 66 erIP 2845]. f
b6e0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
b6f0: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 ocking 0 -trans
b700: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
b710: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
b720: 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 0. puts $s h
b730: 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 ello. fileeve
b740: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
b750: 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 readit $s". s
b760: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
b770: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
b780: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
b790: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
b7a0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
b7b0: 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 er. sendComma
b7c0: 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 nd {close $l}.
b7d0: 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 set count.} 65
b7e0: 35 36 36 0a 0a 74 65 73 74 20 74 6c 73 49 6f 2d 566..test tlsIo-
b7f0: 31 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.1 {testing in
b800: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 73 65 72 heritance of ser
b810: 76 65 72 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 ver sockets} \..
b820: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
b830: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
b840: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
b850: 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 e script1. re
b860: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 moveFile script2
b870: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 .. # Script1
b880: 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 is just a 10 sec
b890: 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 ond delay. If t
b8a0: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
b8b0: 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 . # is inheri
b8c0: 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 ted, it will be
b8d0: 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 held open for 10
b8e0: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 seconds.. se
b8f0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
b900: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
b910: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
b920: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
b930: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
b940: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 ose $f.. # Sc
b950: 72 69 70 74 32 20 63 72 65 61 74 65 73 20 74 68 ript2 creates th
b960: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c e server socket,
b970: 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 launches script
b980: 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 20 61 1,. # waits a
b990: 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 second, and exi
b9a0: 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 72 20 ts. The server
b9b0: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a socket will now.
b9c0: 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20 # be closed
b9d0: 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 20 69 unless script1 i
b9e0: 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 nherited it...
b9f0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
ba00: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 23 20 70 ript2 w]. # p
ba10: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
ba20: 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 63 6c 74 tcltest $::tclt
ba30: 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 est::tcltest].
ba40: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
ba50: 73 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 set tclsh [info
ba60: 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 nameofexecutable
ba70: 5d 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]]. puts $f {
ba80: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
ba90: 65 20 74 63 6c 74 65 73 74 0a 09 70 61 63 6b 61 e tcltest..packa
baa0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
bab0: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
bac0: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
bad0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
bae0: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
baf0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
bb00: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
bb10: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 ile $serverKey 2
bb20: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 828 \]". puts
bb30: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
bb40: 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 pt { file addr p
bb50: 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f ort } {.. clo
bb60: 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 23 20 65 se $file..}..# e
bb70: 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a xec $::tcltest::
bb80: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 20 tcltest script1
bb90: 26 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 &..exec $tclsh s
bba0: 63 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 20 cript1 &..close
bbb0: 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 $f..after 1000 e
bbc0: 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 xit..vwait forev
bbd0: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
bbe0: 73 65 20 24 66 0a 09 0a 20 20 20 20 23 20 4c 61 se $f... # La
bbf0: 75 6e 63 68 20 73 63 72 69 70 74 32 20 61 6e 64 unch script2 and
bc00: 20 77 61 69 74 20 35 20 73 65 63 6f 6e 64 73 0a wait 5 seconds.
bc10: 0a 20 20 20 20 23 20 65 78 65 63 20 24 3a 3a 74 . # exec $::t
bc20: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
bc30: 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 65 78 script2 &. ex
bc40: 65 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 ec [info nameofe
bc50: 78 65 63 75 74 61 62 6c 65 5d 20 73 63 72 69 70 xecutable] scrip
bc60: 74 32 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 t2 &. after 5
bc70: 30 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 000 { set ok_to_
bc80: 70 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 proceed 1 }.
bc90: 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 vwait ok_to_proc
bca0: 65 65 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 eed.. # If we
bcb0: 20 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 can still conne
bcc0: 63 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 ct to the server
bcd0: 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 , the socket got
bce0: 20 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 inherited...
bcf0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
bd00: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
bd10: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
bd20: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
bd30: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
bd40: 6e 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 37 ntKey \. . 127
bd50: 2e 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 .0.0.1 2828} msg
bd60: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 ]} {..set x {ser
bd70: 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ver socket was n
bd80: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 ot inherited}.
bd90: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 } else {..clos
bda0: 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 e $msg..set x {s
bdb0: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
bdc0: 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 inherited}.
bdd0: 7d 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c }.. removeFil
bde0: 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 e script1. re
bdf0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 moveFile script2
be00: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 . set x.} {se
be10: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
be20: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
be30: 74 65 73 74 20 74 6c 73 49 6f 2d 31 32 2e 32 20 test tlsIo-12.2
be40: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
be50: 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 ance of client s
be60: 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b ockets} \..{sock
be70: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
be80: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
be90: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
bea0: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
beb0: 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 ile script2..
bec0: 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 # Script1 is ju
bed0: 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 st a 10 second d
bee0: 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 elay. If the se
bef0: 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 rver socket.
bf00: 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 # is inherited,
bf10: 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 it will be held
bf20: 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f open for 10 seco
bf30: 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b nds.. set f [
bf40: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
bf50: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
bf60: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
bf70: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
bf80: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
bf90: 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 f.. # Script2
bfa0: 20 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e opens the clien
bfb0: 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 t socket and wri
bfc0: 74 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 tes to it. It t
bfd0: 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 hen. # launch
bfe0: 65 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 es script1 and e
bff0: 78 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 xits. If the ch
c000: 69 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 ild process inhe
c010: 72 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 rited the. #
c020: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 client socket, t
c030: 68 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 he socket will s
c040: 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 till be open...
c050: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
c060: 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 cript2 w]. pu
c070: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
c080: 74 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 tclsh [info name
c090: 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a 20 ofexecutable]].
c0a0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
c0b0: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
c0c0: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
c0d0: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
c0e0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
c0f0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
c100: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
c110: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
c120: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
c130: 20 32 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 2829 \]". pu
c140: 74 73 20 24 66 20 7b 0a 09 65 78 65 63 20 24 74 ts $f {..exec $t
c150: 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 clsh script1 &..
c160: 70 75 74 73 20 24 66 20 74 65 73 74 69 6e 67 0a puts $f testing.
c170: 09 66 6c 75 73 68 20 24 66 0a 09 61 66 74 65 72 .flush $f..after
c180: 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 1000 exit..vwai
c190: 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a t forever. }.
c1a0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
c1b0: 20 20 23 20 43 72 65 61 74 65 20 74 68 65 20 73 # Create the s
c1c0: 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 erver socket..
c1d0: 20 20 73 65 74 20 73 65 72 76 65 72 20 5b 74 6c set server [tl
c1e0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
c1f0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
c200: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
c210: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
c220: 76 65 72 4b 65 79 20 5c 0a 09 2d 73 65 72 76 65 verKey \..-serve
c230: 72 20 61 63 63 65 70 74 20 32 38 32 39 5d 0a 20 r accept 2829].
c240: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
c250: 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 file host port
c260: 7d 20 7b 0a 0a 09 23 20 57 68 65 6e 20 74 68 65 } {...# When the
c270: 20 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 client connects
c280: 2c 20 65 73 74 61 62 6c 69 73 68 20 74 68 65 20 , establish the
c290: 72 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c read handler..gl
c2a0: 6f 62 61 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f obal server..clo
c2b0: 73 65 20 24 73 65 72 76 65 72 0a 09 66 69 6c 65 se $server..file
c2c0: 65 76 65 6e 74 20 24 66 69 6c 65 20 72 65 61 64 event $file read
c2d0: 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 able [list getda
c2e0: 74 61 20 24 66 69 6c 65 5d 0a 09 66 63 6f 6e 66 ta $file]..fconf
c2f0: 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 igure $file -buf
c300: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 62 6c 6f fering line -blo
c310: 63 6b 69 6e 67 20 30 0a 09 72 65 74 75 72 6e 0a cking 0..return.
c320: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 67 }. proc g
c330: 65 74 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 etdata { file }
c340: 7b 0a 0a 09 23 20 52 65 61 64 20 68 61 6e 64 6c {...# Read handl
c350: 65 72 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 er on the accept
c360: 65 64 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 ed socket...glob
c370: 61 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 al x..global fai
c380: 6c 65 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 led..set status
c390: 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 [catch {read $fi
c3a0: 6c 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 le} data]..if {$
c3b0: 73 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 status != 0} {..
c3c0: 20 20 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 set x {read
c3d0: 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 failed, error wa
c3e0: 73 20 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 s $data}.. ca
c3f0: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
c400: 65 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b e }..} elseif {[
c410: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b string compare {
c420: 7d 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 } $data]} {..} e
c430: 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 lseif {[fblocked
c440: 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c $file]} {..} el
c450: 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 seif {[eof $file
c460: 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 ]} {.. if {$f
c470: 61 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 ailed} {...set x
c480: 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 {client socket
c490: 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 was inherited}..
c4a0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 } else {...s
c4b0: 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 et x {client soc
c4c0: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
c4d0: 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 rited}.. }..
c4e0: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
c4f0: 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 $file }..} else
c500: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 {.. set x {i
c510: 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a mpossible case}.
c520: 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f . catch { clo
c530: 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 se $file }..}..r
c540: 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 eturn. }..
c550: 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 # If the socket
c560: 20 64 6f 65 73 6e 27 74 20 68 69 74 20 65 6e 64 doesn't hit end
c570: 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 -of-file in 5 se
c580: 63 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 20 23 conds, the. #
c590: 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 script1 process
c5a0: 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 must have inher
c5b0: 69 74 65 64 20 74 68 65 20 63 6c 69 65 6e 74 2e ited the client.
c5c0: 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 .. set failed
c5d0: 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0. after 500
c5e0: 30 20 5b 6c 69 73 74 20 73 65 74 20 66 61 69 6c 0 [list set fail
c5f0: 65 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 ed 1].. # Lau
c600: 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 32 20 nch the script2
c610: 70 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 78 65 process.. exe
c620: 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 c [info nameofex
c630: 65 63 75 74 61 62 6c 65 5d 20 73 63 72 69 70 74 ecutable] script
c640: 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 2 &.. vwait x
c650: 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 . if {!$faile
c660: 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c d} {..vwait fail
c670: 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 6d ed. }. rem
c680: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
c690: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
c6a0: 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 cript2. set x
c6b0: 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 .} {client socke
c6c0: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
c6d0: 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 6f ted}..test tlsIo
c6e0: 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 -12.3 {testing i
c6f0: 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 63 nheritance of ac
c700: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 cepted sockets}
c710: 5c 0a 09 7b 65 6d 70 74 79 20 73 6f 63 6b 65 74 \..{empty socket
c720: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
c730: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
c740: 23 20 68 61 6e 67 73 20 6f 6e 20 4c 69 6e 75 78 # hangs on Linux
c750: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
c760: 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f script1. remo
c770: 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 0a veFile script2..
c780: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
c790: 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 script1 w]. p
c7a0: 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 uts $f {..after
c7b0: 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 10000 exit..vwai
c7c0: 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a t forever. }.
c7d0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
c7e0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
c7f0: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 ript2 w]. put
c800: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 s $f [list set t
c810: 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f clsh [info nameo
c820: 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a 20 20 fexecutable]].
c830: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
c840: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
c850: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
c860: 75 74 73 20 24 66 20 22 63 61 74 63 68 20 7b 73 uts $f "catch {s
c870: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
c880: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
c890: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
c8a0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
c8b0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
c8c0: 20 24 73 65 72 76 65 72 4b 65 79 20 32 39 33 30 $serverKey 2930
c8d0: 20 5c 5d 7d 22 0a 20 20 20 20 70 75 74 73 20 24 \]}". puts $
c8e0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
c8f0: 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 { file host por
c900: 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 t } {.. globa
c910: 6c 20 74 63 6c 73 68 0a 09 20 20 20 20 70 75 74 l tclsh.. put
c920: 73 20 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61 s $file {test da
c930: 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 ta on socket}..
c940: 20 20 20 65 78 65 63 20 24 74 63 6c 73 68 20 73 exec $tclsh s
c950: 63 72 69 70 74 31 20 26 0a 09 20 20 20 20 61 66 cript1 &.. af
c960: 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 7d ter 1000 exit..}
c970: 0a 09 63 61 74 63 68 20 7b 76 77 61 69 74 20 66 ..catch {vwait f
c980: 6f 72 65 76 65 72 7d 0a 20 20 20 20 7d 0a 20 20 orever}. }.
c990: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
c9a0: 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 # Launch the scr
c9b0: 69 70 74 32 20 70 72 6f 63 65 73 73 20 61 6e 64 ipt2 process and
c9c0: 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 connect to it.
c9d0: 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 See how long.
c9e0: 20 20 23 20 74 68 65 20 73 6f 63 6b 65 74 20 73 # the socket s
c9f0: 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 tays open.. e
ca00: 78 65 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 xec [info nameof
ca10: 65 78 65 63 75 74 61 62 6c 65 5d 20 73 63 72 69 executable] scri
ca20: 70 74 32 20 26 0a 0a 20 20 20 20 61 66 74 65 72 pt2 &.. after
ca30: 20 31 30 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 1000 set ok_to_
ca40: 70 72 6f 63 65 65 64 20 31 0a 20 20 20 20 76 77 proceed 1. vw
ca50: 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 ait ok_to_procee
ca60: 64 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c d.. set f [tl
ca70: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
ca80: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
ca90: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
caa0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
cab0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
cac0: 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 39 33 30 127.0.0.1 2930
cad0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
cae0: 20 24 66 20 2d 62 75 66 66 65 72 69 6e 67 20 66 $f -buffering f
caf0: 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a ull -blocking 0.
cb00: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 66 fileevent $f
cb10: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
cb20: 67 65 74 64 61 74 61 20 24 66 5d 0a 0a 20 20 20 getdata $f]..
cb30: 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 # If the socket
cb40: 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 is still open a
cb50: 66 74 65 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 fter 5 seconds,
cb60: 74 68 65 20 73 63 72 69 70 74 31 20 70 72 6f 63 the script1 proc
cb70: 65 73 73 0a 20 20 20 20 23 20 6d 75 73 74 20 68 ess. # must h
cb80: 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 ave inherited th
cb90: 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 e accepted socke
cba0: 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c t... set fail
cbb0: 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 ed 0. after 5
cbc0: 30 30 30 20 73 65 74 20 66 61 69 6c 65 64 20 31 000 set failed 1
cbd0: 0a 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 61 .. proc getda
cbe0: 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 ta { file } {...
cbf0: 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f # Read handler o
cc00: 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 n the client soc
cc10: 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 ket...global x..
cc20: 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 09 73 global failed..s
cc30: 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 68 et status [catch
cc40: 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 61 {read $file} da
cc50: 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 75 73 ta]..if {$status
cc60: 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 != 0} {.. se
cc70: 74 20 78 20 7b 72 65 61 64 20 66 61 69 6c 65 64 t x {read failed
cc80: 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 , error was $dat
cc90: 61 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 a}.. catch {
cca0: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d close $file }..}
ccb0: 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 elseif {[string
ccc0: 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 compare {} $dat
ccd0: 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 a]} {..} elseif
cce0: 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 {[fblocked $file
ccf0: 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b ]} {..} elseif {
cd00: 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 [eof $file]} {..
cd10: 20 20 20 20 69 66 20 7b 24 66 61 69 6c 65 64 7d if {$failed}
cd20: 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 63 65 {...set x {acce
cd30: 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 pted socket was
cd40: 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 inherited}..
cd50: 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 } else {...set x
cd60: 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 {accepted socke
cd70: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
cd80: 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 ted}.. }..
cd90: 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 catch { close $
cda0: 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b file }..} else {
cdb0: 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 6d 70 .. set x {imp
cdc0: 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 ossible case}..
cdd0: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
cde0: 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 $file }..}..ret
cdf0: 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 0a 20 urn. }. .
ce00: 20 20 20 76 77 61 69 74 20 78 0a 0a 20 20 20 20 vwait x..
ce10: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
ce20: 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c t1. removeFil
ce30: 65 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 e script2. se
ce40: 74 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 t x.} {accepted
ce50: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
ce60: 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 nherited}..test
ce70: 74 6c 73 49 6f 2d 31 33 2e 31 20 7b 54 65 73 74 tlsIo-13.1 {Test
ce80: 69 6e 67 20 75 73 65 20 6f 66 20 73 68 61 72 65 ing use of share
ce90: 64 20 73 6f 63 6b 65 74 20 62 65 74 77 65 65 6e d socket between
cea0: 20 74 77 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a two threads} \.
ceb0: 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 68 72 .{socket testthr
cec0: 65 61 64 7d 20 7b 0a 0a 20 20 20 20 72 65 6d 6f ead} {.. remo
ced0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
cee0: 20 20 74 68 72 65 61 64 52 65 61 70 0a 0a 20 20 threadReap..
cef0: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 makeFile {.
cf00: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
cf10: 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c e tls..set f [tl
cf20: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
cf30: 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 r accept 2828]..
cf40: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
cf50: 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 p} {.
cf60: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
cf70: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
cf80: 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ho $s].
cf90: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
cfa0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
cfb0: 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 . }..proc
cfc0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
cfd0: 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 global i.
cfe0: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
cff0: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
d000: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
d010: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
d020: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
d030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d040: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
d050: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
d060: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
d070: 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 } else { ..
d080: 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 incr i.
d090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
d0a0: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
d0b0: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 }..}..set
d0c0: 69 20 30 0a 09 76 77 61 69 74 20 78 0a 09 63 6c i 0..vwait x..cl
d0d0: 6f 73 65 20 24 66 0a 0a 09 23 20 74 68 72 65 61 ose $f...# threa
d0e0: 64 20 63 6c 65 61 6e 73 20 69 74 73 65 6c 66 20 d cleans itself
d0f0: 75 70 2e 0a 09 74 65 73 74 74 68 72 65 61 64 20 up...testthread
d100: 65 78 69 74 0a 20 20 20 20 7d 20 73 63 72 69 70 exit. } scrip
d110: 74 0a 20 20 20 20 0a 20 20 20 20 23 20 63 72 65 t. . # cre
d120: 61 74 65 20 61 20 74 68 72 65 61 64 0a 20 20 20 ate a thread.
d130: 20 73 65 74 20 73 65 72 76 65 72 74 68 72 65 61 set serverthrea
d140: 64 20 5b 74 65 73 74 74 68 72 65 61 64 20 63 72 d [testthread cr
d150: 65 61 74 65 20 7b 20 73 6f 75 72 63 65 20 73 63 eate { source sc
d160: 72 69 70 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 ript } ]. upd
d170: 61 74 65 0a 20 20 20 20 0a 20 20 20 20 61 66 74 ate. . aft
d180: 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 er 1000. set
d190: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 s [tls::socket 1
d1a0: 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 27.0.0.1 2828].
d1b0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
d1c0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
d1d0: 0a 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 70 .. catch {..p
d1e0: 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 0a 09 uts $s "hello"..
d1f0: 67 65 74 73 20 24 73 20 72 65 73 75 6c 74 0a 20 gets $s result.
d200: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
d210: 73 0a 20 20 20 20 75 70 64 61 74 65 0a 0a 20 20 s. update..
d220: 20 20 61 66 74 65 72 20 32 30 30 30 0a 20 20 20 after 2000.
d230: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
d240: 5b 74 68 72 65 61 64 52 65 61 70 5d 0a 20 20 20 [threadReap].
d250: 20 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 . set result
d260: 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 ..} {hello 1}..#
d270: 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 cleanup.if {[st
d280: 72 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a ring match sock*
d290: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
d2a0: 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 == 1} {. puts
d2b0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
d2c0: 65 78 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 exit. flush $c
d2d0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 ommandSocket.}.c
d2e0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d atch {close $com
d2f0: 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 mandSocket}.catc
d300: 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 h {close $remote
d310: 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 ProcChan}.::tclt
d320: 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 est::cleanupTest
d330: 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 s.flush stdout.r
d340: 65 74 75 72 6e 0a 0a eturn..