0000: 23 20 43 6f 6d 6d 61 6e 64 73 20 74 65 73 74 65 # Commands teste
0010: 64 20 69 6e 20 74 68 69 73 20 66 69 6c 65 3a 20 d in this file:
0020: 73 6f 63 6b 65 74 2e 0a 23 0a 23 20 54 68 69 73 socket..#.# This
0030: 20 66 69 6c 65 20 63 6f 6e 74 61 69 6e 73 20 61 file contains a
0040: 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 6f 66 20 74 collection of t
0050: 65 73 74 73 20 66 6f 72 20 6f 6e 65 20 6f 72 20 ests for one or
0060: 6d 6f 72 65 20 6f 66 20 74 68 65 20 54 63 6c 0a more of the Tcl.
0070: 23 20 62 75 69 6c 74 2d 69 6e 20 63 6f 6d 6d 61 # built-in comma
0080: 6e 64 73 2e 20 20 53 6f 75 72 63 69 6e 67 20 74 nds. Sourcing t
0090: 68 69 73 20 66 69 6c 65 20 69 6e 74 6f 20 54 63 his file into Tc
00a0: 6c 20 72 75 6e 73 20 74 68 65 20 74 65 73 74 73 l runs the tests
00b0: 20 61 6e 64 0a 23 20 67 65 6e 65 72 61 74 65 73 and.# generates
00c0: 20 6f 75 74 70 75 74 20 66 6f 72 20 65 72 72 6f output for erro
00d0: 72 73 2e 20 20 4e 6f 20 6f 75 74 70 75 74 20 6d rs. No output m
00e0: 65 61 6e 73 20 6e 6f 20 65 72 72 6f 72 73 20 77 eans no errors w
00f0: 65 72 65 20 66 6f 75 6e 64 2e 0a 23 0a 23 20 43 ere found..#.# C
0100: 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 39 opyright (c) 199
0110: 34 2d 31 39 39 36 20 53 75 6e 20 4d 69 63 72 6f 4-1996 Sun Micro
0120: 73 79 73 74 65 6d 73 2c 20 49 6e 63 2e 0a 23 20 systems, Inc..#
0130: 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 Copyright (c) 19
0140: 39 38 2d 32 30 30 30 20 41 6a 75 62 61 20 53 6f 98-2000 Ajuba So
0150: 6c 75 74 69 6f 6e 73 2e 20 0a 23 0a 23 20 53 65 lutions. .#.# Se
0160: 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 63 65 e the file "lice
0170: 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 20 69 nse.terms" for i
0180: 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73 nformation on us
0190: 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 72 69 age and redistri
01a0: 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 69 73 bution.# of this
01b0: 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20 61 file, and for a
01c0: 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20 41 DISCLAIMER OF A
01d0: 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0a 23 LL WARRANTIES..#
01e0: 0a 23 20 52 43 53 3a 20 40 28 23 29 20 24 49 64 .# RCS: @(#) $Id
01f0: 3a 20 74 6c 73 49 4f 2e 74 65 73 74 2c 76 20 31 : tlsIO.test,v 1
0200: 2e 31 30 20 32 30 30 30 2f 30 36 2f 30 36 20 32 .10 2000/06/06 2
0210: 32 3a 30 30 3a 34 38 20 61 62 6f 72 72 20 45 78 2:00:48 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 38 30 34 38 09 23 20 cl -port 8048.#
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: 38 30 34 38 0a 23 20 20 20 20 20 73 68 65 6c 6c 8048.# 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 38 listen on port 8
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 38 30 34 38 0a 23 20 0a 23 20 rPort 8048.# .#
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 38 moteServerPort 8
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 38 30 34 38 2e 20 49 66 20 61 6c 6c 20 rt 8048. 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 0a 70 61 tls package..pa
0b90: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
0ba0: 73 0a 0a 73 65 74 20 74 6c 73 53 65 72 76 65 72 s..set tlsServer
0bb0: 50 6f 72 74 20 38 30 34 38 0a 0a 73 65 74 20 63 Port 8048..set c
0bc0: 65 72 74 73 44 69 72 20 5b 66 69 6c 65 20 6a 6f ertsDir [file jo
0bd0: 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 in [file dirname
0be0: 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 [info script]]
0bf0: 63 65 72 74 73 5d 20 0a 0a 73 65 74 20 73 65 72 certs] ..set ser
0c00: 76 65 72 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f verCert [file jo
0c10: 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 65 72 in $certsDir ser
0c20: 76 65 72 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 ver.pem].set cli
0c30: 65 6e 74 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f entCert [file jo
0c40: 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 in $certsDir cli
0c50: 65 6e 74 2e 70 65 6d 5d 0a 73 65 74 20 63 61 43 ent.pem].set caC
0c60: 65 72 74 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 ert [file join $
0c70: 63 65 72 74 73 44 69 72 20 63 61 63 65 72 74 2e certsDir cacert.
0c80: 70 65 6d 5d 0a 73 65 74 20 73 65 72 76 65 72 4b pem].set serverK
0c90: 65 79 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 ey [file join $c
0ca0: 65 72 74 73 44 69 72 20 73 6b 65 79 2e 70 65 6d ertsDir skey.pem
0cb0: 5d 0a 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 ].set clientKey
0cc0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
0cd0: 73 44 69 72 20 63 6b 65 79 2e 70 65 6d 5d 0a 0a sDir ckey.pem]..
0ce0: 23 20 53 6f 6d 65 20 74 65 73 74 73 20 72 65 71 # Some tests req
0cf0: 75 69 72 65 20 74 68 65 20 74 65 73 74 74 68 72 uire the testthr
0d00: 65 61 64 20 63 6f 6d 6d 61 6e 64 0a 0a 73 65 74 ead command..set
0d10: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 ::tcltest::test
0d20: 43 6f 6e 73 74 72 61 69 6e 74 73 28 74 65 73 74 Constraints(test
0d30: 74 68 72 65 61 64 29 20 5c 0a 09 5b 65 78 70 72 thread) \..[expr
0d40: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 {[info commands
0d50: 20 74 65 73 74 74 68 72 65 61 64 5d 20 21 3d 20 testthread] !=
0d60: 7b 7d 7d 5d 0a 0a 23 0a 23 20 49 66 20 72 65 6d {}}]..#.# If rem
0d70: 6f 74 65 53 65 72 76 65 72 49 50 20 6f 72 20 72 oteServerIP or r
0d80: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 emoteServerPort
0d90: 61 72 65 20 6e 6f 74 20 73 65 74 2c 20 63 68 65 are not set, che
0da0: 63 6b 20 69 6e 20 74 68 65 0a 23 20 65 6e 76 69 ck in the.# envi
0db0: 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 ronment variable
0dc0: 73 20 66 6f 72 20 65 78 74 65 72 6e 61 6c 6c 79 s for externally
0dd0: 20 73 65 74 20 76 61 6c 75 65 73 2e 0a 23 0a 0a set values..#..
0de0: 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 if {![info exist
0df0: 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 s remoteServerIP
0e00: 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e ]} {. if {[in
0e10: 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 65 fo exists env(re
0e20: 6d 6f 74 65 53 65 72 76 65 72 49 50 29 5d 7d 20 moteServerIP)]}
0e30: 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 72 {..set remoteSer
0e40: 76 65 72 49 50 20 24 65 6e 76 28 72 65 6d 6f 74 verIP $env(remot
0e50: 65 53 65 72 76 65 72 49 50 29 0a 20 20 20 20 7d eServerIP). }
0e60: 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 .}.if {![info ex
0e70: 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 ists remoteServe
0e80: 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 69 66 rPort]} {. if
0e90: 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 {[info exists e
0ea0: 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 50 nv(remoteServerP
0eb0: 6f 72 74 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 ort)]} {..set re
0ec0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 moteServerPort $
0ed0: 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 env(remoteServer
0ee0: 50 6f 72 74 29 0a 20 20 20 20 7d 20 65 6c 73 65 Port). } else
0ef0: 20 7b 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b {. if {[
0f00: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
0f10: 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 09 teServerIP]} {..
0f20: 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 set remoteSe
0f30: 72 76 65 72 50 6f 72 74 20 24 74 6c 73 53 65 72 rverPort $tlsSer
0f40: 76 65 72 50 6f 72 74 0a 20 20 20 20 20 20 20 20 verPort.
0f50: 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 }. }.}..#.# C
0f60: 68 65 63 6b 20 69 66 20 77 65 27 72 65 20 73 75 heck if we're su
0f70: 70 70 6f 73 65 64 20 74 6f 20 64 6f 20 74 65 73 pposed to do tes
0f80: 74 73 20 61 67 61 69 6e 73 74 20 74 68 65 20 72 ts against the r
0f90: 65 6d 6f 74 65 20 73 65 72 76 65 72 0a 23 0a 0a emote server.#..
0fa0: 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 set doTestsWithR
0fb0: 65 6d 6f 74 65 53 65 72 76 65 72 20 31 0a 69 66 emoteServer 1.if
0fc0: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
0fd0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 20 remoteServerIP]
0fe0: 26 26 20 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 && ($tcl_platfor
0ff0: 6d 28 70 6c 61 74 66 6f 72 6d 29 20 21 3d 20 22 m(platform) != "
1000: 6d 61 63 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 macintosh")} {.
1010: 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 set remoteSer
1020: 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a verIP 127.0.0.1.
1030: 7d 0a 69 66 20 7b 28 24 64 6f 54 65 73 74 73 57 }.if {($doTestsW
1040: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
1050: 3d 3d 20 31 29 20 26 26 20 28 21 5b 69 6e 66 6f == 1) && (![info
1060: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 exists remoteSe
1070: 72 76 65 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 rverPort])} {.
1080: 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 set remoteServ
1090: 65 72 50 6f 72 74 20 24 74 6c 73 53 65 72 76 65 erPort $tlsServe
10a0: 72 50 6f 72 74 0a 7d 0a 0a 23 20 41 74 74 65 6d rPort.}..# Attem
10b0: 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f pt to connect to
10c0: 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 a remote server
10d0: 20 69 66 20 6f 6e 65 20 69 73 20 61 6c 72 65 61 if one is alrea
10e0: 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 66 20 69 dy running. If i
10f0: 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 6e 6e 69 t.# is not runni
1100: 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d 65 20 6f ng or for some o
1110: 74 68 65 72 20 72 65 61 73 6f 6e 20 74 68 65 20 ther reason the
1120: 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 2c 20 61 connect fails, a
1130: 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 74 61 72 ttempt to.# star
1140: 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 t the remote ser
1150: 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c ver on the local
1160: 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 6e 67 20 host listening
1170: 6f 6e 20 70 6f 72 74 20 38 30 34 38 2e 20 54 68 on port 8048. Th
1180: 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 64 6f 6e is.# is only don
1190: 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 e on platforms t
11a0: 68 61 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 hat support exec
11b0: 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 68 (i.e. not on th
11c0: 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 70 6c 61 e Mac). On.# pla
11d0: 74 66 6f 72 6d 73 20 74 68 61 74 20 64 6f 20 6e tforms that do n
11e0: 6f 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 2c ot support exec,
11f0: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
1200: 65 72 20 6d 75 73 74 20 62 65 20 73 74 61 72 74 er must be start
1210: 65 64 0a 23 20 62 79 20 74 68 65 20 75 73 65 72 ed.# by the user
1220: 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 before running
1230: 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 65 74 20 the tests...set
1240: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 22 remoteProcChan "
1250: 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 ".set commandSoc
1260: 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 6f 54 65 ket "".if {$doTe
1270: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1280: 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 74 63 68 ver} {. catch
1290: 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 {close $command
12a0: 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 66 20 7b Socket}. if {
12b0: 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d [catch {set comm
12c0: 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a andSocket [tls::
12d0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
12e0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
12f0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
1300: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
1310: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
1320: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 5c remoteServerIP \
1330: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
1340: 76 65 72 50 6f 72 74 5d 7d 5d 20 21 3d 20 30 7d verPort]}] != 0}
1350: 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 63 6f {..if {[info co
1360: 6d 6d 61 6e 64 73 20 65 78 65 63 5d 20 3d 3d 20 mmands exec] ==
1370: 22 22 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6e ""} {.. set n
1380: 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f oRemoteTestReaso
1390: 6e 20 22 63 61 6e 27 74 20 65 78 65 63 22 0a 09 n "can't exec"..
13a0: 20 20 20 20 73 65 74 20 64 6f 54 65 73 74 73 57 set doTestsW
13b0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
13c0: 30 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 0..} else {..
13d0: 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 set remoteServe
13e0: 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 09 20 rIP 127.0.0.1..
13f0: 20 20 20 73 65 74 20 72 65 6d 6f 74 65 46 69 6c set remoteFil
1400: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
1410: 64 5d 20 72 65 6d 6f 74 65 2e 74 63 6c 5d 0a 09 d] remote.tcl]..
1420: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
1430: 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 set remoteProcCh
1440: 61 6e 20 5c 0a 09 09 09 09 5b 6f 70 65 6e 20 22 an \.....[open "
1450: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
1460: 74 3a 3a 74 63 6c 74 65 73 74 20 24 72 65 6d 6f t::tcltest $remo
1470: 74 65 46 69 6c 65 20 5c 0a 09 09 09 09 09 2d 73 teFile \......-s
1480: 65 72 76 65 72 49 73 53 69 6c 65 6e 74 20 5c 0a erverIsSilent \.
1490: 09 09 09 09 09 2d 70 6f 72 74 20 24 72 65 6d 6f .....-port $remo
14a0: 74 65 53 65 72 76 65 72 50 6f 72 74 20 5c 0a 09 teServerPort \..
14b0: 09 09 09 09 2d 61 64 64 72 65 73 73 20 24 72 65 ....-address $re
14c0: 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 22 20 5c moteServerIP]" \
14d0: 0a 09 09 09 09 09 77 2b 5d 7d 20 5c 0a 09 09 20 ......w+]} \...
14e0: 20 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 msg] == 0} {..
14f0: 09 61 66 74 65 72 20 31 30 30 30 0a 09 09 69 66 .after 1000...if
1500: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f {[catch {set co
1510: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 mmandSocket [tls
1520: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 20 20 20 ::socket \...
1530: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
1540: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
1550: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
1560: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 09 09 $clientKey \....
1570: 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 .$remoteServerIP
1580: 20 5c 0a 09 09 09 09 24 72 65 6d 6f 74 65 53 65 \.....$remoteSe
1590: 72 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 20 rverPort]} msg]
15a0: 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 66 63 == 0} {... fc
15b0: 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e onfigure $comman
15c0: 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 dSocket -transla
15d0: 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 tion crlf -buffe
15e0: 72 69 6e 67 20 6c 69 6e 65 0a 09 09 7d 20 65 6c ring line...} el
15f0: 73 65 20 7b 0a 09 09 20 20 20 20 73 65 74 20 6e se {... set n
1600: 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f oRemoteTestReaso
1610: 6e 20 24 6d 73 67 0a 09 09 20 20 20 20 73 65 74 n $msg... set
1620: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
1630: 74 65 53 65 72 76 65 72 20 30 0a 09 09 7d 0a 09 teServer 0...}..
1640: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 } else {...s
1650: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1660: 65 61 73 6f 6e 20 22 24 6d 73 67 20 24 3a 3a 74 eason "$msg $::t
1670: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 22 cltest::tcltest"
1680: 0a 09 09 73 65 74 20 64 6f 54 65 73 74 73 57 69 ...set doTestsWi
1690: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 thRemoteServer 0
16a0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
16b0: 20 65 6c 73 65 20 7b 0a 09 66 63 6f 6e 66 69 67 else {..fconfig
16c0: 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ure $commandSock
16d0: 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 et -translation
16e0: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
16f0: 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 line. }.}..#
1700: 53 6f 6d 65 20 74 65 73 74 73 20 61 72 65 20 72 Some tests are r
1710: 75 6e 20 6f 6e 6c 79 20 69 66 20 77 65 20 61 72 un only if we ar
1720: 65 20 64 6f 69 6e 67 20 74 65 73 74 69 6e 67 20 e doing testing
1730: 61 67 61 69 6e 73 74 20 61 20 72 65 6d 6f 74 65 against a remote
1740: 20 73 65 72 76 65 72 2e 0a 73 65 74 20 3a 3a 74 server..set ::t
1750: 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 cltest::testCons
1760: 74 72 61 69 6e 74 73 28 64 6f 54 65 73 74 73 57 traints(doTestsW
1770: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 29 ithRemoteServer)
1780: 20 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d $doTestsWithRem
1790: 6f 74 65 53 65 72 76 65 72 0a 69 66 20 7b 24 64 oteServer.if {$d
17a0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
17b0: 53 65 72 76 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 Server == 0} {.
17c0: 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 if {[string f
17d0: 69 72 73 74 20 73 20 24 3a 3a 74 63 6c 74 65 73 irst s $::tcltes
17e0: 74 3a 3a 76 65 72 62 6f 73 65 5d 20 21 3d 20 2d t::verbose] != -
17f0: 31 7d 20 7b 0a 20 20 20 20 09 70 75 74 73 20 22 1} {. .puts "
1800: 53 6b 69 70 70 69 6e 67 20 74 65 73 74 73 20 77 Skipping tests w
1810: 69 74 68 20 72 65 6d 6f 74 65 20 73 65 72 76 65 ith remote serve
1820: 72 2e 20 53 65 65 20 74 65 73 74 73 2f 73 6f 63 r. See tests/soc
1830: 6b 65 74 2e 74 65 73 74 20 66 6f 72 22 0a 09 70 ket.test for"..p
1840: 75 74 73 20 22 69 6e 66 6f 72 6d 61 74 69 6f 6e uts "information
1850: 20 6f 6e 20 68 6f 77 20 74 6f 20 72 75 6e 20 72 on how to run r
1860: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 22 0a 09 emote server."..
1870: 70 75 74 73 20 22 52 65 61 73 6f 6e 20 66 6f 72 puts "Reason for
1880: 20 6e 6f 74 20 64 6f 69 6e 67 20 72 65 6d 6f 74 not doing remot
1890: 65 20 74 65 73 74 73 3a 20 24 6e 6f 52 65 6d 6f e tests: $noRemo
18a0: 74 65 54 65 73 74 52 65 61 73 6f 6e 22 0a 20 20 teTestReason".
18b0: 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 77 65 }.}..#.# If we
18c0: 20 64 6f 20 74 68 65 20 74 65 73 74 73 2c 20 64 do the tests, d
18d0: 65 66 69 6e 65 20 61 20 63 6f 6d 6d 61 6e 64 20 efine a command
18e0: 74 6f 20 73 65 6e 64 20 61 20 63 6f 6d 6d 61 6e to send a comman
18f0: 64 20 74 6f 20 74 68 65 0a 23 20 72 65 6d 6f 74 d to the.# remot
1900: 65 20 73 65 72 76 65 72 2e 0a 23 0a 0a 69 66 20 e server..#..if
1910: 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d {$doTestsWithRem
1920: 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 7d 20 oteServer == 1}
1930: 7b 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 43 {. proc sendC
1940: 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 67 6c ommand {c} {..gl
1950: 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b obal commandSock
1960: 65 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 24 63 et...if {[eof $c
1970: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b ommandSocket]} {
1980: 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d .. error "rem
1990: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
19a0: 70 65 61 72 65 64 22 0a 09 7d 0a 0a 09 69 66 20 peared"..}...if
19b0: 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 {[catch {puts $c
19c0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 24 63 7d ommandSocket $c}
19d0: 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 msg]} {.. er
19e0: 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 ror "remote serv
19f0: 65 72 20 64 69 73 61 70 70 61 65 72 65 64 3a 20 er disappaered:
1a00: 24 6d 73 67 22 0a 09 7d 0a 09 69 66 20 7b 5b 63 $msg"..}..if {[c
1a10: 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d atch {puts $comm
1a20: 61 6e 64 53 6f 63 6b 65 74 20 22 2d 2d 4d 61 72 andSocket "--Mar
1a30: 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 ker--Marker--Mar
1a40: 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 7b 0a ker--"} msg]} {.
1a50: 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f . error "remo
1a60: 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 te server disapp
1a70: 65 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a eared: $msg"..}.
1a80: 0a 09 73 65 74 20 72 65 73 70 20 22 22 0a 09 77 ..set resp ""..w
1a90: 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 20 20 hile {1} {..
1aa0: 73 65 74 20 6c 69 6e 65 20 5b 67 65 74 73 20 24 set line [gets $
1ab0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 0a 09 commandSocket]..
1ac0: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 63 6f if {[eof $co
1ad0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a mmandSocket]} {.
1ae0: 09 09 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 ..error "remote
1af0: 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 server disappear
1b00: 65 64 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 ed".. }..
1b10: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
1b20: 61 72 65 20 24 6c 69 6e 65 20 22 2d 2d 4d 61 72 are $line "--Mar
1b30: 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 ker--Marker--Mar
1b40: 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 7b 0a ker--"] == 0} {.
1b50: 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f ..if {[string co
1b60: 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 72 mpare [lindex $r
1b70: 65 73 70 20 30 5d 20 65 72 72 6f 72 5d 20 3d 3d esp 0] error] ==
1b80: 20 30 7d 20 7b 0a 09 09 20 20 20 20 65 72 72 6f 0} {... erro
1b90: 72 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 r [lindex $resp
1ba0: 31 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 1]...} else {...
1bb0: 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 6e 64 return [lind
1bc0: 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 7d 0a ex $resp 1]...}.
1bd0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
1be0: 61 70 70 65 6e 64 20 72 65 73 70 20 24 6c 69 6e append resp $lin
1bf0: 65 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a 09 7d e "\n".. }..}
1c00: 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 73 74 20 74 . }.}..test t
1c10: 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 67 20 70 61 lsIO-1.1 {arg pa
1c20: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
1c30: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
1c40: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
1c50: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
1c60: 74 20 2d 73 65 72 76 65 72 7d 20 6d 73 67 5d 20 t -server} msg]
1c70: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
1c80: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
1c90: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
1ca0: 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 -server command
1cb0: 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d ?options? port"}
1cc0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
1cd0: 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 2 {arg parsing f
1ce0: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
1cf0: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
1d00: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
1d10: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
1d20: 65 72 20 66 6f 6f 7d 20 6d 73 67 5d 20 24 6d 73 er foo} msg] $ms
1d30: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
1d40: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
1d50: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
1d60: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
1d70: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
1d80: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 33 20 7b test tlsIO-1.3 {
1d90: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
1da0: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
1db0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
1dc0: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
1dd0: 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 7d :socket -myaddr}
1de0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
1df0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
1e00: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
1e10: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
1e20: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
1e30: 73 74 20 74 6c 73 49 4f 2d 31 2e 34 20 7b 61 72 st tlsIO-1.4 {ar
1e40: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1e50: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1e60: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1e70: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1e80: 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 32 ocket -myaddr 12
1e90: 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 5d 20 24 6d 7.0.0.1} msg] $m
1ea0: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
1eb0: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
1ec0: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f "tls::socket ?o
1ed0: 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 ptions? host por
1ee0: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
1ef0: 2d 31 2e 35 20 7b 61 72 67 20 70 61 72 73 69 6e -1.5 {arg parsin
1f00: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
1f10: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
1f20: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
1f30: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
1f40: 79 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 yport} msg] $msg
1f50: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
1f60: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
1f70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
1f80: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
1f90: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
1fa0: 2e 36 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .6 {arg parsing
1fb0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1fc0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1fd0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1fe0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 tls::socket -myp
1ff0: 6f 72 74 20 78 78 78 78 7d 20 6d 73 67 5d 20 24 ort xxxx} msg] $
2000: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2010: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2020: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2030: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2040: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2050: 4f 2d 31 2e 37 20 7b 61 72 67 20 70 61 72 73 69 O-1.7 {arg parsi
2060: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2070: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
2080: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
2090: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
20a0: 6d 79 70 6f 72 74 20 32 35 32 32 7d 20 6d 73 67 myport 2522} msg
20b0: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
20c0: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
20d0: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
20e0: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
20f0: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
2100: 6c 73 49 4f 2d 31 2e 38 20 7b 61 72 67 20 70 61 lsIO-1.8 {arg pa
2110: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2120: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2130: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2140: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2150: 74 20 2d 66 72 6f 62 6f 7a 7d 20 6d 73 67 5d 20 t -froboz} msg]
2160: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
2170: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
2180: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
2190: 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 ?options? host p
21a0: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
21b0: 49 4f 2d 31 2e 39 20 7b 61 72 67 20 70 61 72 73 IO-1.9 {arg pars
21c0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
21d0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
21e0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
21f0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2200: 2d 73 65 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 -server foo -myp
2210: 6f 72 74 20 32 35 32 31 20 33 33 33 33 7d 20 6d ort 2521 3333} m
2220: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2230: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2240: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2250: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
2260: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
2270: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2280: 4f 2d 31 2e 31 30 20 7b 61 72 67 20 70 61 72 73 O-1.10 {arg pars
2290: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
22a0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
22b0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
22c0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
22d0: 68 6f 73 74 20 32 35 32 38 20 2d 6a 75 6e 6b 7d host 2528 -junk}
22e0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
22f0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
2300: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
2310: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
2320: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
2330: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 31 20 7b 61 st tlsIO-1.11 {a
2340: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2350: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2360: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2370: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2380: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 socket -server c
2390: 61 6c 6c 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d allback 2520 --}
23a0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
23b0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
23c0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
23d0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f ocket -server co
23e0: 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 mmand ?options?
23f0: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2400: 73 49 4f 2d 31 2e 31 32 20 7b 61 72 67 20 70 61 sIO-1.12 {arg pa
2410: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2420: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2430: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2440: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2450: 74 20 66 6f 6f 20 62 61 64 70 6f 72 74 7d 20 6d t foo badport} m
2460: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 65 sg] $msg.} {1 {e
2470: 78 70 65 63 74 65 64 20 69 6e 74 65 67 65 72 20 xpected integer
2480: 62 75 74 20 67 6f 74 20 22 62 61 64 70 6f 72 74 but got "badport
2490: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
24a0: 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.1 {tcp connect
24b0: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ion} {socket std
24c0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
24d0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
24e0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
24f0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
2500: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
2510: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
2520: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
2530: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
2540: 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 20 20 _out"]. }.
2550: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2560: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2570: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
2580: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
2590: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
25a0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
25b0: 76 65 72 4b 65 79 20 24 74 6c 73 53 65 72 76 65 verKey $tlsServe
25c0: 72 50 6f 72 74 20 5c 5d 22 0a 20 20 20 20 70 75 rPort \]". pu
25d0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
25e0: 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 cept {file addr
25f0: 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f port} {.. glo
2600: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
2610: 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 done.
2620: 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d close $file..}
2630: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
2640: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
2650: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
2660: 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 e $f..puts $x.
2670: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
2680: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
2690: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
26a0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
26b0: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
26c0: 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b s $f x. if {[
26d0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
26e0: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
26f0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
2700: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
2710: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
2720: 31 32 37 2e 30 2e 30 2e 31 20 24 74 6c 73 53 65 127.0.0.1 $tlsSe
2730: 72 76 65 72 50 6f 72 74 20 6d 73 67 5d 7d 20 7b rverPort msg]} {
2740: 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 . set x $
2750: 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b msg. } else {
2760: 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 . lappend
2770: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
2780: 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a close $msg.
2790: 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e }. lappen
27a0: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
27b0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
27c0: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f et x.} {ready do
27d0: 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f ne {}}..if [info
27e0: 20 65 78 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a exists port] {.
27f0: 20 20 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 incr port.}
2800: 65 6c 73 65 20 7b 20 0a 20 20 20 20 73 65 74 20 else { . set
2810: 70 6f 72 74 20 5b 65 78 70 72 20 24 74 6c 73 53 port [expr $tlsS
2820: 65 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 erverPort + [pid
2830: 5d 25 31 30 32 34 5d 0a 7d 0a 0a 74 65 73 74 20 ]%1024].}..test
2840: 74 6c 73 49 4f 2d 32 2e 32 20 7b 74 63 70 20 63 tlsIO-2.2 {tcp c
2850: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 onnection with c
2860: 6c 69 65 6e 74 20 70 6f 72 74 20 73 70 65 63 69 lient port speci
2870: 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 fied} {socket st
2880: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
2890: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
28a0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
28b0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
28c0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
28d0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
28e0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
28f0: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 "set x done"].
2900: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
2910: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
2920: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
2930: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
2940: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
2950: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
2960: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
2970: 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 829 \]". puts
2980: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
2990: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
29a0: 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 rt} {.
29b0: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
29c0: 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 puts "[ge
29d0: 74 73 20 24 66 69 6c 65 5d 20 24 70 6f 72 74 22 ts $file] $port"
29e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
29f0: 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 se $file.
2a00: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
2a10: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
2a20: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
2a30: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
2a40: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
2a50: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2a60: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
2a70: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
2a80: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
2a90: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
2aa0: 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 74 0a global port.
2ab0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
2ac0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 tls::socket -myp
2ad0: 6f 72 74 20 24 70 6f 72 74 20 5c 0a 09 2d 63 65 ort $port \..-ce
2ae0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
2af0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2b00: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
2b10: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
2b20: 30 2e 31 20 38 38 32 39 7d 20 73 6f 63 6b 5d 7d 0.1 8829} sock]}
2b30: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
2b40: 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 7b 63 $sock..catch {c
2b50: 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 lose [tls::socke
2b60: 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 t 127.0.0.1 8829
2b70: 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ]}. } else {.
2b80: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
2b90: 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 ck hello..flush
2ba0: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 $sock. la
2bb0: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
2bc0: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
2bd0: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
2be0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2bf0: 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 61 64 79 x.} [list ready
2c00: 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 22 5d 0a "hello $port"].
2c10: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 33 20 .test tlsIO-2.3
2c20: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 {tcp connection
2c30: 77 69 74 68 20 63 6c 69 65 6e 74 20 69 6e 74 65 with client inte
2c40: 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 7d rface specified}
2c50: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
2c60: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
2c70: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
2c80: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
2c90: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
2ca0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
2cb0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
2cc0: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
2cd0: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
2ce0: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
2cf0: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
2d00: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
2d10: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
2d20: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
2d30: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
2d40: 73 65 72 76 65 72 4b 65 79 20 38 38 33 30 20 5c serverKey 8830 \
2d50: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
2d60: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 ..proc accept {f
2d70: 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b ile addr port} {
2d80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f . glo
2d90: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
2da0: 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 66 puts "[gets $f
2db0: 69 6c 65 5d 20 24 61 64 64 72 22 0a 20 20 20 20 ile] $addr".
2dc0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
2dd0: 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ile.
2de0: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
2df0: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
2e00: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
2e10: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
2e20: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
2e30: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
2e40: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
2e50: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
2e60: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
2e70: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
2e80: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
2e90: 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 socket -myaddr 1
2ea0: 32 37 2e 30 2e 30 2e 31 20 5c 0a 09 2d 63 65 72 27.0.0.1 \..-cer
2eb0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
2ec0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
2ed0: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
2ee0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
2ef0: 2e 31 20 38 38 33 30 7d 20 73 6f 63 6b 5d 7d 20 .1 8830} sock]}
2f00: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
2f10: 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 $sock. } else
2f20: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
2f30: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 74 $sock hello..cat
2f40: 63 68 20 7b 66 6c 75 73 68 20 24 73 6f 63 6b 7d ch {flush $sock}
2f50: 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 . lappend
2f60: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
2f70: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
2f80: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
2f90: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
2fa0: 7b 72 65 61 64 79 20 7b 68 65 6c 6c 6f 20 31 32 {ready {hello 12
2fb0: 37 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 20 7.0.0.1}}..test
2fc0: 74 6c 73 49 4f 2d 32 2e 34 20 7b 74 63 70 20 63 tlsIO-2.4 {tcp c
2fd0: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 73 onnection with s
2fe0: 65 72 76 65 72 20 69 6e 74 65 72 66 61 63 65 20 erver interface
2ff0: 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b specified} {sock
3000: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
3010: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
3020: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
3030: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
3040: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
3050: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
3060: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
3070: 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 2000 "set x don
3080: 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 e"]. }. pu
3090: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
30a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
30b0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
30c0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
30d0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
30e0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
30f0: 4b 65 79 20 2d 6d 79 61 64 64 72 20 5b 69 6e 66 Key -myaddr [inf
3100: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 o hostname] 8831
3110: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
3120: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
3130: 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d {file addr port}
3140: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 {. g
3150: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
3160: 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 puts "[gets
3170: 24 66 69 6c 65 5d 22 0a 20 20 20 20 20 20 20 20 $file]".
3180: 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a close $file.
3190: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
31a0: 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 x done..}..puts
31b0: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
31c0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
31d0: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 mer..close $f.
31e0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
31f0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
3200: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
3210: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
3220: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
3230: 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b s $f x. if {[
3240: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
3250: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
3260: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
3270: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
3280: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
3290: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
32a0: 38 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 8831} sock]} {.
32b0: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f set x $so
32c0: 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ck. } else {.
32d0: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
32e0: 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 ck hello..flush
32f0: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 $sock. la
3300: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
3310: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
3320: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
3330: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3340: 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c x.} {ready hell
3350: 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 o}..test tlsIO-2
3360: 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .5 {tcp connecti
3370: 6f 6e 20 77 69 74 68 20 72 65 64 75 6e 64 61 6e on with redundan
3380: 74 20 73 65 72 76 65 72 20 70 6f 72 74 7d 20 7b t server port} {
3390: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
33a0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
33b0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
33c0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
33d0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
33e0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
33f0: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
3400: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
3410: 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 done"]. }.
3420: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
3430: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
3440: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
3450: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
3460: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
3470: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
3480: 72 76 65 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 rverKey 8832 \]"
3490: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
34a0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
34b0: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 e addr port} {.
34c0: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
34d0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
34e0: 70 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 6c puts "[gets $fil
34f0: 65 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 e]".
3500: 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 20 close $file.
3510: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
3520: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
3530: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
3540: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
3550: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
3560: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3570: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
3580: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
3590: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
35a0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
35b0: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
35c0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
35d0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
35e0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
35f0: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
3600: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
3610: 30 2e 30 2e 31 20 38 38 33 32 7d 20 73 6f 63 6b 0.0.1 8832} sock
3620: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
3630: 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 x $sock. } e
3640: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 lse {. pu
3650: 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 ts $sock hello..
3660: 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 flush $sock.
3670: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
3680: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
3690: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
36a0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
36b0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
36c0: 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 6c y hello}.test tl
36d0: 73 49 4f 2d 32 2e 36 20 7b 74 63 70 20 63 6f 6e sIO-2.6 {tcp con
36e0: 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 nection} {socket
36f0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 } {. set stat
3700: 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b us ok. if {![
3710: 63 61 74 63 68 20 7b 73 65 74 20 73 6f 63 6b 20 catch {set sock
3720: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
3730: 2e 30 2e 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 20 .0.0.1 8833]}]}
3740: 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b {..if {![catch {
3750: 67 65 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a gets $sock}]} {.
3760: 09 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 . set status
3770: 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 broken..}..close
3780: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
3790: 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b set status.} ok
37a0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 37 ..test tlsIO-2.7
37b0: 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6f {echo server, o
37c0: 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 ne line} {socket
37d0: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
37e0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
37f0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3800: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
3810: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
3820: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
3830: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
3840: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
3850: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
3860: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
3870: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
3880: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
3890: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
38a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
38b0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
38c0: 79 20 38 38 33 34 20 5c 5d 22 0a 20 20 20 20 70 y 8834 \]". p
38d0: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
38e0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
38f0: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 file
3900: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
3910: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
3920: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
3930: 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e $s -translation
3940: 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c lf -buffering l
3950: 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 ine. }..p
3960: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
3970: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
3980: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
3990: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
39a0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
39b0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
39d0: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
39e0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
39f0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
3a00: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
3a10: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
3a20: 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 $l.
3a30: 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 }..}..puts read
3a40: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
3a50: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
3a60: 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 .close $f..puts
3a70: 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 63 done. }. c
3a80: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
3a90: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
3aa0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
3ab0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
3ac0: 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 gets $f.
3ad0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
3ae0: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
3af0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
3b00: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
3b10: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
3b20: 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 34 5d 0a 127.0.0.1 8834].
3b30: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
3b40: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
3b50: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c e -translation l
3b60: 66 0a 20 20 20 20 70 75 74 73 20 24 73 20 22 68 f. puts $s "h
3b70: 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b ello abcdefghijk
3b80: 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 66 74 65 72 lmnop". after
3b90: 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 78 20 1000. set x
3ba0: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c [gets $s]. cl
3bb0: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 79 ose $s. set y
3bc0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
3bd0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 6c 69 73 74 lose $f. list
3be0: 20 24 78 20 24 79 0a 7d 20 7b 7b 68 65 6c 6c 6f $x $y.} {{hello
3bf0: 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f abcdefghijklmno
3c00: 70 7d 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 p} done}..test t
3c10: 6c 73 49 4f 2d 32 2e 38 20 7b 65 63 68 6f 20 73 lsIO-2.8 {echo s
3c20: 65 72 76 65 72 2c 20 6c 6f 6f 70 20 35 30 20 74 erver, loop 50 t
3c30: 69 6d 65 73 2c 20 73 69 6e 67 6c 65 20 63 6f 6e imes, single con
3c40: 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 nection} {socket
3c50: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 stdio} {. se
3c60: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3c70: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3c80: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
3c90: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
3ca0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3cb0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3cc0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3cd0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
3ce0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
3cf0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
3d00: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 20 $serverKey 8835
3d10: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
3d20: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
3d30: 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 s a p} {.
3d40: 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 fileevent $
3d50: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
3d60: 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 echo $s].
3d70: 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 fconfigure
3d80: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
3d90: 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 ine. }..p
3da0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
3db0: 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 global i.
3dc0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c set l
3dd0: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 [gets $s].
3de0: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 if {[eof
3df0: 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 $s]} {.
3e00: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
3e10: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
3e20: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
3e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
3e40: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
3e50: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 } else { ..
3e60: 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a incr i.
3e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e80: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
3e90: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 }..}..s
3ea0: 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 65 61 et i 0..puts rea
3eb0: 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 dy..set timer [a
3ec0: 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 20 fter 20000 "set
3ed0: 78 20 64 6f 6e 65 22 5d 0a 09 76 77 61 69 74 20 x done"]..vwait
3ee0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
3ef0: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
3f00: 0a 09 70 75 74 73 20 22 64 6f 6e 65 20 24 69 22 ..puts "done $i"
3f10: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
3f20: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
3f30: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
3f40: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
3f50: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
3f60: 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 gets $f. set
3f70: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
3f80: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
3f90: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3fa0: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
3fb0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
3fc0: 30 2e 30 2e 31 20 38 38 33 35 5d 0a 20 20 20 20 0.0.1 8835].
3fd0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
3fe0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
3ff0: 20 20 63 61 74 63 68 20 7b 0a 09 66 6f 72 20 7b catch {..for {
4000: 73 65 74 20 78 20 30 7d 20 7b 24 78 20 3c 20 35 set x 0} {$x < 5
4010: 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 20 0} {incr x} {..
4020: 20 20 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c puts $s "hell
4030: 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e o abcdefghijklmn
4040: 6f 70 22 0a 09 20 20 20 20 67 65 74 73 20 24 73 op".. gets $s
4050: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ..}. }. cl
4060: 6f 73 65 20 24 73 0a 20 20 20 20 63 61 74 63 68 ose $s. catch
4070: 20 7b 73 65 74 20 78 20 5b 67 65 74 73 20 24 66 {set x [gets $f
4080: 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a ]}. close $f.
4090: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 64 6f 6e set x.} {don
40a0: 65 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 e 50}..test tlsI
40b0: 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20 63 6f O-2.9 {socket co
40c0: 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 nflict} {socket
40d0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 stdio} {. set
40e0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
40f0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
4100: 38 32 38 5d 0a 20 20 20 20 72 65 6d 6f 76 65 46 828]. removeF
4110: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
4120: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
4130: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 2d 6e t w]. puts -n
4140: 6f 6e 65 77 6c 69 6e 65 20 24 66 20 7b 70 61 63 onewline $f {pac
4150: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
4160: 3b 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 ; tls::socket -s
4170: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
4180: 38 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 8}. close $f.
4190: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
41a0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
41b0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
41c0: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
41d0: 20 24 66 0a 20 20 20 20 61 66 74 65 72 20 31 30 $f. after 10
41e0: 30 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 73 0. set x [lis
41f0: 74 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 t [catch {close
4200: 24 66 7d 20 6d 73 67 5d 20 24 6d 73 67 5d 0a 20 $f} msg] $msg].
4210: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
4220: 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c set x.} {1 {coul
4230: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
4240: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
4250: 79 20 69 6e 20 75 73 65 0a 20 20 20 20 77 68 69 y in use. whi
4260: 6c 65 20 65 78 65 63 75 74 69 6e 67 0a 22 3a 3a le executing."::
4270: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 7b socket -server {
4280: 74 6c 73 3a 3a 5f 61 63 63 65 70 74 20 7b 2d 73 tls::_accept {-s
4290: 65 72 76 65 72 20 31 7d 20 61 63 63 65 70 74 7d erver 1} accept}
42a0: 20 38 38 32 38 22 0a 20 20 20 20 28 22 65 76 61 8828". ("eva
42b0: 6c 22 20 62 6f 64 79 20 6c 69 6e 65 20 31 29 0a l" body line 1).
42c0: 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f 6d invoked from
42d0: 20 77 69 74 68 69 6e 0a 22 65 76 61 6c 20 3a 3a within."eval ::
42e0: 73 6f 63 6b 65 74 20 24 73 6f 70 74 73 22 0a 20 socket $sopts".
42f0: 20 20 20 28 70 72 6f 63 65 64 75 72 65 20 22 74 (procedure "t
4300: 6c 73 3a 3a 73 6f 63 6b 65 74 22 20 6c 69 6e 65 ls::socket" line
4310: 20 36 32 29 0a 20 20 20 20 69 6e 76 6f 6b 65 64 62). invoked
4320: 20 66 72 6f 6d 20 77 69 74 68 69 6e 0a 22 74 6c from within."tl
4330: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4340: 72 20 61 63 63 65 70 74 20 38 38 32 38 22 0a 20 r accept 8828".
4350: 20 20 20 28 66 69 6c 65 20 22 73 63 72 69 70 74 (file "script
4360: 22 20 6c 69 6e 65 20 31 29 7d 7d 0a 0a 74 65 73 " line 1)}}..tes
4370: 74 20 74 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 6c t tlsIO-2.10 {cl
4380: 6f 73 65 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 ose on accept, a
4390: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 6c ccepted socket l
43a0: 69 76 65 73 7d 20 7b 73 6f 63 6b 65 74 20 6b 6e ives} {socket kn
43b0: 6f 77 6e 42 75 67 7d 20 7b 0a 20 20 20 20 73 65 ownBug} {. se
43c0: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 t done 0. set
43d0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
43e0: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
43f0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 med_out"]. se
4400: 74 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t ss [tls::socke
4410: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
4420: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
4430: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
4440: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4450: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
4460: 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 30]. proc acc
4470: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
4480: 6c 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 lobal ss..close
4490: 24 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 $ss..fileevent $
44a0: 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 s readable "read
44b0: 69 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 it $s"..fconfigu
44c0: 72 65 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a re $s -trans lf.
44d0: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 }. proc r
44e0: 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f eadit {s} {..glo
44f0: 62 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 bal done..gets $
4500: 73 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 s..close $s..set
4510: 20 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 done 1. }.
4520: 20 20 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 set cs [tls::s
4530: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
4540: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
4550: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
4560: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
4570: 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d ey [info hostnam
4580: 65 5d 20 38 38 33 30 5d 0a 20 20 20 20 63 6c 6f e] 8830]. clo
4590: 73 65 20 24 63 73 0a 0a 20 20 20 20 76 77 61 69 se $cs.. vwai
45a0: 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 t done. after
45b0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
45c0: 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 31 0a set done.} 1.
45d0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 31 .test tlsIO-2.11
45e0: 20 7b 64 65 74 65 63 74 69 6e 67 20 6e 65 77 20 {detecting new
45f0: 64 61 74 61 7d 20 7b 73 6f 63 6b 65 74 20 6b 6e data} {socket kn
4600: 6f 77 6e 42 75 67 7d 20 7b 0a 20 20 20 20 70 72 ownBug} {. pr
4610: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
4620: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 6b } {..global sock
4630: 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 0a 09 73 ..set sock $s..s
4640: 65 74 20 66 20 5b 6f 70 65 6e 20 61 77 62 2e 6c et f [open awb.l
4650: 6f 67 20 77 5d 0a 09 70 75 74 73 20 24 66 20 5b og w]..puts $f [
4660: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 catch {tls::hand
4670: 73 68 61 6b 65 20 24 73 6f 63 6b 7d 20 65 72 72 shake $sock} err
4680: 5d 0a 09 70 75 74 73 20 24 66 20 22 65 72 72 3a ]..puts $f "err:
4690: 20 24 65 72 72 22 0a 09 70 75 74 73 20 24 66 20 $err"..puts $f
46a0: 22 5b 74 6c 73 3a 3a 73 74 61 74 75 73 20 24 73 "[tls::status $s
46b0: 6f 63 6b 5d 22 0a 09 63 6c 6f 73 65 20 24 73 0a ock]"..close $s.
46c0: 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 }.. set s
46d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 [tls::socket -r
46e0: 65 71 75 69 72 65 20 30 20 2d 72 65 71 75 65 73 equire 0 -reques
46f0: 74 20 30 20 2d 73 65 72 76 65 72 20 61 63 63 65 t 0 -server acce
4700: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
4710: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
4720: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
4730: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
4740: 38 34 30 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 8400]. set so
4750: 63 6b 20 22 22 0a 20 20 20 20 73 65 74 20 73 32 ck "". set s2
4760: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
4770: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
4780: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4790: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
47a0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
47b0: 2e 30 2e 31 20 38 34 30 30 5d 0a 20 20 20 20 76 .0.1 8400]. v
47c0: 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 wait sock. pu
47d0: 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 ts $s2 one. f
47e0: 6c 75 73 68 20 24 73 32 0a 20 20 20 20 61 66 74 lush $s2. aft
47f0: 65 72 20 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 er 500. fconf
4800: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
4810: 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 65 74 20 cking 0. set
4820: 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 6f result [gets $so
4830: 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 ck]. lappend
4840: 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 6f result [gets $so
4850: 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 ck]. fconfigu
4860: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
4870: 6e 67 20 31 0a 20 20 20 20 70 75 74 73 20 24 73 ng 1. puts $s
4880: 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 2 two. flush
4890: 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 $s2. fconfigu
48a0: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
48b0: 6e 67 20 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 ng 0. lappend
48c0: 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 result [gets $s
48d0: 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 ock]. fconfig
48e0: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
48f0: 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 ing 1. close
4900: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
4910: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b . close $sock
4920: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
4930: 7d 20 7b 6f 6e 65 20 7b 7d 20 74 77 6f 7d 0a 0a } {one {} two}..
4940: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 32 20 test tlsIO-2.12
4950: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b {tcp connection;
4960: 20 6e 6f 20 63 65 72 74 69 66 69 63 61 74 65 73 no certificates
4970: 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 specified} {soc
4980: 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 ket stdio pcCras
4990: 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 h} {. removeF
49a0: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
49b0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
49c0: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
49d0: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
49e0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
49f0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
4a00: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
4a10: 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 5b 74 6c out"]..set f [tl
4a20: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4a30: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 09 r accept 8828]..
4a40: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
4a50: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 e addr port} {..
4a60: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 global x..
4a70: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
4a80: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
4a90: 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 file..}..puts re
4aa0: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
4ab0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
4ac0: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
4ad0: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
4ae0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4af0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
4b00: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
4b10: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
4b20: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
4b30: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
4b40: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
4b50: 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 0.1 8828} msg]}
4b60: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
4b70: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
4b80: 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e {. lappen
4b90: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
4ba0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 close $msg
4bb0: 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 . }. lappe
4bc0: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
4bd0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4be0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
4bf0: 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c one {}}..test tl
4c00: 73 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 sIO-3.1 {socket
4c10: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
4c20: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
4c30: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
4c40: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4c50: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
4c60: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
4c70: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
4c80: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
4c90: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
4ca0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4cb0: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
4cc0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
4cd0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
4ce0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
4cf0: 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 y 8828 \]". p
4d00: 75 74 73 20 24 66 20 7b 0a 09 70 75 74 73 20 72 uts $f {..puts r
4d10: 65 61 64 79 0a 09 67 65 74 73 20 73 74 64 69 6e eady..gets stdin
4d20: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
4d30: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
4d40: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
4d50: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
4d60: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
4d70: 5d 22 20 72 2b 5d 0a 20 20 20 20 67 65 74 73 20 ]" r+]. gets
4d80: 24 66 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 $f. set x [li
4d90: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
4da0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
4db0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
4dc0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4dd0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
4de0: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 2d ientKey \. .-
4df0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
4e00: 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 28} msg] \...$ms
4e10: 67 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 62 g]. puts $f b
4e20: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a ye. close $f.
4e30: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b set x.} {1 {
4e40: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
4e50: 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c cket: address al
4e60: 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a ready in use}}..
4e70: 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 32 20 7b test tlsIO-3.2 {
4e80: 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 server with seve
4e90: 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f ral clients} {so
4ea0: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
4eb0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
4ec0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
4ed0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
4ee0: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
4ef0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
4f00: 20 74 6c 73 0a 09 73 65 74 20 74 31 20 5b 61 66 tls..set t1 [af
4f10: 74 65 72 20 33 30 30 30 30 20 22 73 65 74 20 78 ter 30000 "set x
4f20: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
4f30: 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 t t2 [after 3100
4f40: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
4f50: 75 74 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 66 ut"]..set t3 [af
4f60: 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 78 ter 32000 "set x
4f70: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
4f80: 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 t counter 0.
4f90: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
4fa0: 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et s \[tls::sock
4fb0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4fc0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
4fd0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
4fe0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
4ff0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 $serverKey 8828
5000: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
5010: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
5020: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 {s a p} {.. f
5030: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
5040: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
5050: 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 $s].. fconfig
5060: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
5070: 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 g line..}..proc
5080: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
5090: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
50a0: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
50b0: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ts $s].
50c0: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
50d0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
50e0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
50f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
5100: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
5110: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
5120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5130: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
5140: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 }..}..p
5150: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
5160: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
5170: 20 24 74 31 0a 09 76 77 61 69 74 20 78 0a 09 61 $t1..vwait x..a
5180: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a fter cancel $t2.
5190: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
51a0: 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f 73 cancel $t3..clos
51b0: 65 20 24 73 0a 09 70 75 74 73 20 24 78 0a 20 20 e $s..puts $x.
51c0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
51d0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
51e0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
51f0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
5200: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 73 65 ipt]" r+]. se
5210: 74 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t x [gets $f].
5220: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
5230: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
5240: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
5250: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
5260: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
5270: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
5280: 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 7.0.0.1 8828].
5290: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 fconfigure $s1
52a0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
52b0: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
52c0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
52d0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
52e0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
52f0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5300: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
5310: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 127.0.0.1 8828]
5320: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5330: 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s2 -buffering l
5340: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b ine. set s3 [
5350: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
5360: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
5370: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
5380: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
5390: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
53a0: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
53b0: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
53c0: 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e re $s3 -bufferin
53d0: 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b g line. for {
53e0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
53f0: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
5400: 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 puts $s1 hello,s
5410: 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 1..gets $s1..put
5420: 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 s $s2 hello,s2..
5430: 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 gets $s2..puts $
5440: 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 s3 hello,s3..get
5450: 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 s $s3. }.
5460: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c close $s1. cl
5470: 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 ose $s2. clos
5480: 65 20 24 73 33 0a 20 20 20 20 6c 61 70 70 65 6e e $s3. lappen
5490: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
54a0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
54b0: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f et x.} {ready do
54c0: 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ne}..test tlsIO-
54d0: 34 2e 31 20 7b 73 65 72 76 65 72 20 77 69 74 68 4.1 {server with
54e0: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
54f0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
5500: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
5510: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
5520: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
5530: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
5540: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
5550: 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 quire tls..gets
5560: 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 stdin. }.
5570: 70 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c puts $f "set s \
5580: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
5590: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
55a0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
55b0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
55c0: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
55d0: 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 8828 \]". pu
55e0: 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e 66 69 67 ts $f {..fconfig
55f0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
5600: 67 20 6c 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 g line..for {set
5610: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d i 0} {$i < 100}
5620: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 {incr i} {..
5630: 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 puts $s hello..
5640: 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 gets $s..}..
5650: 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 62 close $s..puts b
5660: 79 65 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 ye..gets stdin.
5670: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
5680: 66 0a 20 20 20 20 73 65 74 20 70 31 20 5b 6f 70 f. set p1 [op
5690: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
56a0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
56b0: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
56c0: 66 63 6f 6e 66 69 67 75 72 65 20 24 70 31 20 2d fconfigure $p1 -
56d0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
56e0: 20 20 20 73 65 74 20 70 32 20 5b 6f 70 65 6e 20 set p2 [open
56f0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
5700: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
5710: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f pt]" r+]. fco
5720: 6e 66 69 67 75 72 65 20 24 70 32 20 2d 62 75 66 nfigure $p2 -buf
5730: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5740: 73 65 74 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b set p3 [open "|[
5750: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5760: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5770: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
5780: 67 75 72 65 20 24 70 33 20 2d 62 75 66 66 65 72 gure $p3 -buffer
5790: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 72 6f ing line. pro
57a0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
57b0: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
57c0: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
57d0: 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 e..fileevent $s
57e0: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
57f0: 63 68 6f 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 cho $s]. }.
5800: 20 20 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 proc echo {s}
5810: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 {..global x.
5820: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
5830: 24 73 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b $s]. if {
5840: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 [eof $s]} {.
5850: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
5860: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
5870: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
5880: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
5890: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a puts $s $l.
58a0: 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a }. }.
58b0: 20 20 20 20 73 65 74 20 74 31 20 5b 61 66 74 65 set t1 [afte
58c0: 72 20 33 30 30 30 30 20 22 73 65 74 20 78 20 74 r 30000 "set x t
58d0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
58e0: 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 et t2 [after 310
58f0: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5900: 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 33 out"]. set t3
5910: 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 73 [after 32000 "s
5920: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
5930: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
5940: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
5950: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
5960: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
5970: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
5980: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
5990: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
59a0: 38 32 38 5d 0a 20 20 20 20 70 75 74 73 20 24 70 828]. puts $p
59b0: 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 1 open. puts
59c0: 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 $p2 open. put
59d0: 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 20 76 s $p3 open. v
59e0: 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 wait x. vwait
59f0: 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 x. vwait x.
5a00: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
5a10: 24 74 31 0a 20 20 20 20 61 66 74 65 72 20 63 61 $t1. after ca
5a20: 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 61 66 74 ncel $t2. aft
5a30: 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 20 20 er cancel $t3.
5a40: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
5a50: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
5a60: 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 20 5b end l [list p1 [
5a70: 67 65 74 73 20 24 70 31 5d 20 24 78 5d 0a 20 20 gets $p1] $x].
5a80: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
5a90: 74 20 70 32 20 5b 67 65 74 73 20 24 70 32 5d 20 t p2 [gets $p2]
5aa0: 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $x]. lappend
5ab0: 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 74 73 l [list p3 [gets
5ac0: 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 70 75 $p3] $x]. pu
5ad0: 74 73 20 24 70 31 20 62 79 65 0a 20 20 20 20 70 ts $p1 bye. p
5ae0: 75 74 73 20 24 70 32 20 62 79 65 0a 20 20 20 20 uts $p2 bye.
5af0: 70 75 74 73 20 24 70 33 20 62 79 65 0a 20 20 20 puts $p3 bye.
5b00: 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 20 63 close $p1. c
5b10: 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 63 6c 6f lose $p2. clo
5b20: 73 65 20 24 70 33 0a 20 20 20 20 73 65 74 20 6c se $p3. set l
5b30: 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 6f 6e 65 .} {{p1 bye done
5b40: 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e 65 7d 20 } {p2 bye done}
5b50: 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a {p3 bye done}}..
5b60: 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e 32 20 7b test tlsIO-4.2 {
5b70: 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c byte order probl
5b80: 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 ems, socket numb
5b90: 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 ers, htons} {soc
5ba0: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 ket} {. set x
5bb0: 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 ok. if {[cat
5bc0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
5bd0: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 33 -server dodo 0x3
5be0: 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 000} msg]} {..se
5bf0: 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 t x $msg. } e
5c00: 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 lse {..close $ms
5c10: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
5c20: 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 x.} ok..test tls
5c30: 49 4f 2d 35 2e 31 20 7b 62 79 74 65 20 6f 72 64 IO-5.1 {byte ord
5c40: 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 er problems, soc
5c50: 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f ket numbers, hto
5c60: 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 ns} \..{socket u
5c70: 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d nixOnly notRoot}
5c80: 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f {. set x {co
5c90: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5ca0: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 et: not owner}.
5cb0: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
5cc0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
5cd0: 76 65 72 20 64 6f 64 6f 20 30 78 31 7d 20 6d 73 ver dodo 0x1} ms
5ce0: 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 g]} {. se
5cf0: 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c t x {htons probl
5d00: 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 em, should be di
5d10: 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f sallowed, are yo
5d20: 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f u running as SU?
5d30: 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 }..close $msg.
5d40: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
5d50: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
5d60: 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 ocket: not owner
5d70: 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 32 }.test tlsIO-5.2
5d80: 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f {byte order pro
5d90: 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 blems, socket nu
5da0: 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 mbers, htons} {s
5db0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
5dc0: 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 x {couldn't ope
5dd0: 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e n socket: port n
5de0: 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a umber too high}.
5df0: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
5e00: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
5e10: 72 76 65 72 20 64 6f 64 6f 20 30 78 31 30 30 30 rver dodo 0x1000
5e20: 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 0} msg]} {..set
5e30: 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c 75 74 69 x {port resoluti
5e40: 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 on problem, shou
5e50: 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 ld be disallowed
5e60: 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 }..close $msg.
5e70: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
5e80: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
5e90: 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 ocket: port numb
5ea0: 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 74 65 73 er too high}.tes
5eb0: 74 20 74 6c 73 49 4f 2d 35 2e 33 20 7b 62 79 74 t tlsIO-5.3 {byt
5ec0: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
5ed0: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
5ee0: 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 , htons} \..{soc
5ef0: 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 ket unixOnly not
5f00: 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 Root} {. set
5f10: 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e x {couldn't open
5f20: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
5f30: 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 er}. if {![ca
5f40: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
5f50: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 32 31 -server dodo 21
5f60: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
5f70: 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c {htons problem,
5f80: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
5f90: 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 lowed, are you r
5fa0: 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 unning as SU?}..
5fb0: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
5fc0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f . set x.} {co
5fd0: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5fe0: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a et: not owner}..
5ff0: 74 65 73 74 20 74 6c 73 49 4f 2d 36 2e 31 20 7b test tlsIO-6.1 {
6000: 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 accept callback
6010: 65 72 72 6f 72 7d 20 7b 75 6e 65 78 70 6c 61 69 error} {unexplai
6020: 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 nedFailure socke
6030: 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d t stdio pcCrash}
6040: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
6050: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
6060: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
6070: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
6080: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
6090: 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 quire tls..gets
60a0: 73 74 64 69 6e 0a 09 74 6c 73 3a 3a 73 6f 63 6b stdin..tls::sock
60b0: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 34 et 127.0.0.1 884
60c0: 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 8. }. clos
60d0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
60e0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
60f0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
6100: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
6110: 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 proc bgerror a
6120: 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a rgs {..global x.
6130: 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 .set x $args.
6140: 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 }. proc acce
6150: 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 pt {s a p} {expr
6160: 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 10 / 0}. set
6170: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
6180: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
6190: 38 34 38 5d 0a 20 20 20 20 70 75 74 73 20 24 66 848]. puts $f
61a0: 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 hello. close
61b0: 20 24 66 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $f. set time
61c0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
61d0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
61e0: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
61f0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
6200: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
6210: 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 $s. rename bg
6220: 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 error {}. set
6230: 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 x.} {{divide by
6240: 20 7a 65 72 6f 7d 7d 0a 0a 23 20 62 75 67 20 72 zero}}..# bug r
6250: 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e eport #5812 fcon
6260: 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 figure doesn't r
6270: 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 eturn value for
6280: 27 2d 70 65 65 72 6e 61 6d 65 27 0a 0a 74 65 73 '-peername'..tes
6290: 74 20 74 6c 73 49 4f 2d 37 2e 31 20 7b 74 65 73 t tlsIO-7.1 {tes
62a0: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
62b0: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b ific options} {k
62c0: 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 20 73 nownBug socket s
62d0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
62e0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
62f0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
6300: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
6310: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
6320: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
6330: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 74 6c . puts $f "tl
6340: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6350: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
6360: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
6370: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
6380: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
6390: 65 79 20 38 38 32 30 22 0a 20 20 20 20 70 75 74 ey 8820". put
63a0: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
63b0: 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 20 ept args {..
63c0: 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 global x.. se
63d0: 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 t x done..}..put
63e0: 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d s ready..set tim
63f0: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
6400: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
6410: 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 "]..vwait x..aft
6420: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
6430: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
6440: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
6450: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
6460: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
6470: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
6480: 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 gets $f. set
6490: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
64a0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
64b0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
64c0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
64d0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
64e0: 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 \.. 127.0.0.1
64f0: 20 38 38 32 30 5d 0a 20 20 20 20 73 65 74 20 70 8820]. set p
6500: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 [fconfigure $s
6510: 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 -peername]. c
6520: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
6530: 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 22 e $f. set l "
6540: 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ". lappend l
6550: 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 [string compare
6560: 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 20 31 32 [lindex $p 0] 12
6570: 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 7.0.0.1]. lap
6580: 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 pend l [string c
6590: 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 ompare [lindex $
65a0: 70 20 32 5d 20 38 38 32 30 5d 0a 20 20 20 20 6c p 2] 8820]. l
65b0: 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 append l [llengt
65c0: 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a h $p].} {0 0 3}.
65d0: 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 23 35 .# bug report #5
65e0: 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 20 64 812 fconfigure d
65f0: 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 76 61 oesn't return va
6600: 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 lue for '-sockna
6610: 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d me'..test tlsIO-
6620: 37 2e 32 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 7.2 {testing soc
6630: 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 ket specific opt
6640: 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 6e 42 75 67 20 ions} {knownBug
6650: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
6660: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
6670: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
6680: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
6690: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
66a0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
66b0: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
66c0: 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 s $f "tls::socke
66d0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
66e0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
66f0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
6700: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6710: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 31 22 $serverKey 8821"
6720: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
6730: 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 proc accept args
6740: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 {.. global x
6750: 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 .. set x done
6760: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
6770: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
6780: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
6790: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 imed_out"]..vwai
67a0: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
67b0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 l $timer. }.
67c0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
67d0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
67e0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
67f0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
6800: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
6810: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6820: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
6830: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
6840: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
6850: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
6860: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
6870: 32 37 2e 30 2e 30 2e 31 20 38 38 32 31 5d 0a 20 27.0.0.1 8821].
6880: 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 set p [fconfi
6890: 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d gure $s -socknam
68a0: 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a e]. close $s.
68b0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
68c0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
68d0: 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 ppend l [llength
68e0: 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 $p]. lappend
68f0: 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d l [lindex $p 0]
6900: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
6910: 73 74 72 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 string equal [li
6920: 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 31 5d ndex $p 2] 8821]
6930: 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 .} {3 127.0.0.1
6940: 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 0}..test tlsIO-7
6950: 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .3 {testing sock
6960: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
6970: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ons} {socket} {.
6980: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6990: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
69a0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
69b0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
69c0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
69d0: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 Key \. .-serv
69e0: 65 72 20 61 63 63 65 70 74 20 38 38 32 32 5d 0a er accept 8822].
69f0: 20 20 20 20 73 65 74 20 6c 20 5b 66 63 6f 6e 66 set l [fconf
6a00: 69 67 75 72 65 20 24 73 5d 0a 20 20 20 20 63 6c igure $s]. cl
6a10: 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 ose $s. updat
6a20: 65 0a 20 20 20 20 6c 6c 65 6e 67 74 68 20 24 6c e. llength $l
6a30: 0a 7d 20 31 32 0a 0a 23 20 62 75 67 20 72 65 70 .} 12..# bug rep
6a40: 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 ort #5812 fconfi
6a50: 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 gure doesn't ret
6a60: 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d urn value for '-
6a70: 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 sockname'..test
6a80: 74 6c 73 49 4f 2d 37 2e 34 20 7b 74 65 73 74 69 tlsIO-7.4 {testi
6a90: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
6aa0: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b 6e 6f ic options} {kno
6ab0: 77 6e 42 75 67 20 73 6f 63 6b 65 74 7d 20 7b 0a wnBug socket} {.
6ac0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6ad0: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
6ae0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
6af0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
6b00: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
6b10: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 Key \. .-serv
6b20: 65 72 20 61 63 63 65 70 74 20 38 38 32 33 5d 0a er accept 8823].
6b30: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
6b40: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
6b50: 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e l x..set x [fcon
6b60: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e figure $s -sockn
6b70: 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 ame]..close $s.
6b80: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
6b90: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
6ba0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
6bb0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
6bc0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
6bd0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 clientKey \.
6be0: 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d .[info hostname]
6bf0: 20 38 38 32 33 5d 0a 20 20 20 20 73 65 74 20 74 8823]. set t
6c00: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
6c10: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
6c20: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut"]. vwait x
6c30: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
6c40: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
6c50: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
6c60: 24 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 $s1. set l ""
6c70: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
6c80: 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c lindex $x 2] [ll
6c90: 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 38 38 32 ength $x].} {882
6ca0: 33 20 33 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f 3 3}..# bug repo
6cb0: 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 rt #5812 fconfig
6cc0: 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 ure doesn't retu
6cd0: 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 rn value for '-s
6ce0: 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 ockname'..test t
6cf0: 6c 73 49 4f 2d 37 2e 35 20 7b 74 65 73 74 69 6e lsIO-7.5 {testin
6d00: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
6d10: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 c options} {know
6d20: 6e 42 75 67 20 73 6f 63 6b 65 74 20 75 6e 69 78 nBug socket unix
6d30: 4f 72 50 63 7d 20 7b 0a 20 20 20 20 73 65 74 20 OrPc} {. set
6d40: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
6d50: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
6d60: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
6d70: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
6d80: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 $serverKey \.
6d90: 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 .-server accep
6da0: 74 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 t 8829]. proc
6db0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
6dc0: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 {..global x..set
6dd0: 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 x [fconfigure $
6de0: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c s -sockname]..cl
6df0: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
6e00: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
6e10: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
6e20: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
6e30: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
6e40: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
6e50: 79 20 5c 0a 20 20 20 20 09 31 32 37 2e 30 2e 30 y \. .127.0.0
6e60: 2e 31 20 38 38 32 39 5d 0a 20 20 20 20 73 65 74 .1 8829]. set
6e70: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
6e80: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
6e90: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
6ea0: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
6eb0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
6ec0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
6ed0: 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c 20 e $s1. set l
6ee0: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
6ef0: 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 5d 20 5b [lindex $x 0] [
6f00: 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c lindex $x 2] [ll
6f10: 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 31 32 37 ength $x].} {127
6f20: 2e 30 2e 30 2e 31 20 38 38 32 39 20 33 7d 0a 0a .0.0.1 8829 3}..
6f30: 74 65 73 74 20 74 6c 73 49 4f 2d 38 2e 31 20 7b test tlsIO-8.1 {
6f40: 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 63 20 66 testing -async f
6f50: 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 lag on sockets}
6f60: 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 {unexplainedHang
6f70: 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 socket} {. #
6f80: 20 74 65 73 74 20 73 65 65 6d 73 20 74 6f 20 68 test seems to h
6f90: 61 6e 67 20 2d 2d 20 61 77 62 20 36 2f 32 2f 32 ang -- awb 6/2/2
6fa0: 30 30 30 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 000. # NOTE:
6fb0: 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 61 This test may fa
6fc0: 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 il on some Solar
6fd0: 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 20 is 2.4 systems.
6fe0: 49 66 20 69 74 20 64 6f 65 73 2c 0a 20 20 20 20 If it does,.
6ff0: 23 20 63 68 65 63 6b 20 74 68 61 74 20 79 6f 75 # check that you
7000: 20 68 61 76 65 20 74 68 65 73 65 20 70 61 74 63 have these patc
7010: 68 65 73 20 69 6e 73 74 61 6c 6c 65 64 20 28 75 hes installed (u
7020: 73 69 6e 67 20 73 68 6f 77 72 65 76 20 2d 70 29 sing showrev -p)
7030: 3a 0a 20 20 20 20 23 0a 20 20 20 20 23 20 31 30 :. #. # 10
7040: 31 39 30 37 2d 30 35 2c 20 31 30 31 39 32 35 2d 1907-05, 101925-
7050: 30 32 2c 20 31 30 31 39 34 35 2d 31 34 2c 20 31 02, 101945-14, 1
7060: 30 31 39 35 39 2d 30 33 2c 20 31 30 31 39 36 39 01959-03, 101969
7070: 2d 30 35 2c 20 31 30 31 39 37 33 2d 30 33 2c 0a -05, 101973-03,.
7080: 20 20 20 20 23 20 31 30 31 39 37 37 2d 30 33 2c # 101977-03,
7090: 20 31 30 31 39 38 31 2d 30 32 2c 20 31 30 31 39 101981-02, 1019
70a0: 38 35 2d 30 31 2c 20 31 30 32 30 30 31 2d 30 33 85-01, 102001-03
70b0: 2c 20 31 30 32 30 30 33 2d 30 31 2c 20 31 30 32 , 102003-01, 102
70c0: 30 30 37 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 007-01,. # 10
70d0: 32 30 31 31 2d 30 32 2c 20 31 30 32 30 32 34 2d 2011-02, 102024-
70e0: 30 31 2c 20 31 30 32 30 33 39 2d 30 31 2c 20 31 01, 102039-01, 1
70f0: 30 32 30 34 34 2d 30 31 2c 20 31 30 32 30 34 38 02044-01, 102048
7100: 2d 30 31 2c 20 31 30 32 30 36 32 2d 30 33 2c 0a -01, 102062-03,.
7110: 20 20 20 20 23 20 31 30 32 30 36 36 2d 30 34 2c # 102066-04,
7120: 20 31 30 32 30 37 30 2d 30 31 2c 20 31 30 32 31 102070-01, 1021
7130: 30 35 2d 30 31 2c 20 31 30 32 31 35 33 2d 30 33 05-01, 102153-03
7140: 2c 20 31 30 32 32 31 36 2d 30 31 2c 20 31 30 32 , 102216-01, 102
7150: 32 33 32 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 232-01,. # 10
7160: 31 38 37 38 2d 30 33 2c 20 31 30 31 38 37 39 2d 1878-03, 101879-
7170: 30 31 2c 20 31 30 31 38 38 30 2d 30 33 2c 20 31 01, 101880-03, 1
7180: 30 31 39 33 33 2d 30 31 2c 20 31 30 31 39 35 30 01933-01, 101950
7190: 2d 30 31 2c 20 31 30 32 30 33 30 2d 30 31 2c 0a -01, 102030-01,.
71a0: 20 20 20 20 23 20 31 30 32 30 35 37 2d 30 38 2c # 102057-08,
71b0: 20 31 30 32 31 34 30 2d 30 31 2c 20 31 30 31 39 102140-01, 1019
71c0: 32 30 2d 30 32 2c 20 31 30 31 39 32 31 2d 30 39 20-02, 101921-09
71d0: 2c 20 31 30 31 39 32 32 2d 30 37 2c 20 31 30 31 , 101922-07, 101
71e0: 39 32 33 2d 30 33 0a 20 20 20 20 23 0a 20 20 20 923-03. #.
71f0: 20 23 20 49 66 20 61 66 74 65 72 20 69 6e 73 74 # If after inst
7200: 61 6c 6c 69 6e 67 20 74 68 65 73 65 20 70 61 74 alling these pat
7210: 63 68 65 73 20 79 6f 75 20 61 72 65 20 73 74 69 ches you are sti
7220: 6c 6c 20 65 78 70 65 72 69 65 6e 63 69 6e 67 20 ll experiencing
7230: 61 0a 20 20 20 20 23 20 70 72 6f 62 6c 65 6d 2c a. # problem,
7240: 20 70 6c 65 61 73 65 20 65 6d 61 69 6c 20 6a 79 please email jy
7250: 6c 40 65 6e 67 2e 73 75 6e 2e 63 6f 6d 2e 20 57 l@eng.sun.com. W
7260: 65 20 68 61 76 65 20 6e 6f 74 20 6f 62 73 65 72 e have not obser
7270: 76 65 64 20 74 68 69 73 0a 20 20 20 20 23 20 66 ved this. # f
7280: 61 69 6c 75 72 65 20 6f 6e 20 53 6f 6c 61 72 69 ailure on Solari
7290: 73 20 32 2e 35 2c 20 73 6f 20 61 6e 6f 74 68 65 s 2.5, so anothe
72a0: 72 20 6f 70 74 69 6f 6e 20 28 69 6e 73 74 65 61 r option (instea
72b0: 64 20 6f 66 20 69 6e 73 74 61 6c 6c 69 6e 67 0a d of installing.
72c0: 20 20 20 20 23 20 74 68 65 73 65 20 70 61 74 63 # these patc
72d0: 68 65 73 29 20 69 73 20 74 6f 20 75 70 67 72 61 hes) is to upgra
72e0: 64 65 20 74 6f 20 53 6f 6c 61 72 69 73 20 32 2e de to Solaris 2.
72f0: 35 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 5.. set s [tl
7300: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
7310: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
7320: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
7330: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
7340: 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 verKey \. .-s
7350: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
7360: 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 0]. proc acce
7370: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
7380: 6f 62 61 6c 20 78 0a 09 70 75 74 73 20 24 73 20 obal x..puts $s
7390: 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 bye..close $s..s
73a0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a et x done. }.
73b0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
73c0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
73d0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
73e0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
73f0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
7400: 74 4b 65 79 20 5c 0a 09 2d 61 73 79 6e 63 20 5b tKey \..-async [
7410: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 info hostname] 8
7420: 38 33 30 5d 0a 20 20 20 20 76 77 61 69 74 20 78 830]. vwait x
7430: 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65 74 73 . set z [gets
7440: 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s1]. close
7450: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
7460: 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 . set z.} bye
7470: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 ..test tlsIO-9.1
7480: 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f {testing spurio
7490: 75 73 20 65 76 65 6e 74 73 7d 20 7b 75 6e 65 78 us events} {unex
74a0: 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f 63 6b plainedHang sock
74b0: 65 74 7d 20 7b 0a 20 20 20 20 23 20 6c 6f 63 6b et} {. # lock
74c0: 73 20 75 70 20 0a 20 20 20 20 73 65 74 20 6c 65 s up . set le
74d0: 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 n 0. set spur
74e0: 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 ious 0. set d
74f0: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 one 0. proc r
7500: 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a eadlittle {s} {.
7510: 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 .global spurious
7520: 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c done len..set l
7530: 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 [read $s 1]..if
7540: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
7550: 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 $l] == 0} {..
7560: 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d if {![eof $s]}
7570: 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f {...incr spurio
7580: 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b us.. } else {
7590: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
75a0: 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a t done 1.. }.
75b0: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 .} else {.. i
75c0: 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 ncr len [string
75d0: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 length $l]..}.
75e0: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
75f0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
7600: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
7610: 66 66 65 72 69 6e 67 20 6e 6f 6e 65 20 2d 62 6c ffering none -bl
7620: 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 66 69 6c 65 ocking off..file
7630: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
7640: 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 74 e [list readlitt
7650: 6c 65 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 le $s]. }.
7660: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7670: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
7680: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
7690: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
76a0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
76b0: 20 5c 0a 20 20 20 09 2d 73 65 72 76 65 72 20 61 \. .-server a
76c0: 63 63 65 70 74 20 38 38 33 31 5d 0a 20 20 20 20 ccept 8831].
76d0: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
76e0: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
76f0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
7700: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7710: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
7720: 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 \. .[info hos
7730: 74 6e 61 6d 65 5d 20 38 38 33 31 5d 0a 20 20 20 tname] 8831].
7740: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
7750: 20 24 63 20 30 31 32 33 34 35 36 37 38 39 30 31 $c 012345678901
7760: 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 2345678901234567
7770: 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 8901234567890123
7780: 34 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 73 65 456789. close
7790: 20 24 63 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c. set time
77a0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
77b0: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
77c0: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
77d0: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
77e0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
77f0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 close $s. lis
7800: 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e t $spurious $len
7810: 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 20 .} {0 50}..test
7820: 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 73 74 69 tlsIO-9.2 {testi
7830: 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 ng async write,
7840: 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 73 fileevents, flus
7850: 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 h on close} {soc
7860: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 ket} {. set f
7870: 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a 20 20 20 irstblock "".
7880: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
7890: 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 20 69 7d $i < 5} {incr i}
78a0: 20 7b 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b {set firstblock
78b0: 20 22 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 66 "a$firstblock$f
78c0: 69 72 73 74 62 6c 6f 63 6b 22 7d 0a 20 20 20 20 irstblock"}.
78d0: 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 set secondblock
78e0: 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 "". for {set
78f0: 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d 20 7b i 0} {$i < 16} {
7900: 69 6e 63 72 20 69 7d 20 7b 0a 09 73 65 74 20 73 incr i} {..set s
7910: 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 65 econdblock "b$se
7920: 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e 64 condblock$second
7930: 62 6c 6f 63 6b 22 0a 20 20 20 20 7d 0a 20 20 20 block". }.
7940: 20 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 set l [tls::soc
7950: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
7960: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
7970: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7980: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
7990: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
79a0: 61 63 63 65 70 74 20 38 38 33 32 5d 0a 20 20 20 accept 8832].
79b0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
79c0: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
79d0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
79e0: 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 0 -translation l
79f0: 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 f -buffersize 16
7a00: 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 384 \...-bufferi
7a10: 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 ng line..fileeve
7a20: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
7a30: 72 65 61 64 61 62 6c 65 20 24 73 22 0a 20 20 20 readable $s".
7a40: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 }. proc read
7a50: 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 able {s} {..set
7a60: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 66 69 6c l [gets $s]..fil
7a70: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
7a80: 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 le {}..after 100
7a90: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 0 respond $s.
7aa0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 }. proc resp
7ab0: 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 ond {s} {..globa
7ac0: 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 70 75 l firstblock..pu
7ad0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
7ae0: 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 $firstblock..af
7af0: 74 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 ter 1000 writeda
7b00: 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 ta $s. }.
7b10: 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b proc writedata {
7b20: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 s} {..global sec
7b30: 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 74 73 20 2d ondblock..puts -
7b40: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 nonewline $s $se
7b50: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 condblock..close
7b60: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
7b70: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
7b80: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
7b90: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
7ba0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7bb0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
7bc0: 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e .[info hostn
7bd0: 61 6d 65 5d 20 38 38 33 32 5d 0a 20 20 20 20 66 ame] 8832]. f
7be0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
7bf0: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 ocking 0 -trans
7c00: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
7c10: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
7c20: 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 0. puts $s h
7c30: 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 ello. proc re
7c40: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
7c50: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 al count done..s
7c60: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 et l [read $s]..
7c70: 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 incr count [stri
7c80: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 ng length $l]..i
7c90: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
7ca0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 close $s..
7cb0: 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a set done 1..}.
7cc0: 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 }. fileev
7cd0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
7ce0: 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 "readit $s".
7cf0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
7d00: 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 10000 "set done
7d10: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
7d20: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
7d30: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
7d40: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 6c mer. close $l
7d50: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d . set count.}
7d60: 20 36 35 35 36 36 0a 0a 74 65 73 74 20 74 6c 73 65566..test tls
7d70: 49 4f 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 20 IO-9.3 {testing
7d80: 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 EOF stickyness}
7d90: 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 {unexplainedHang
7da0: 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 socket} {. #
7db0: 20 68 61 6e 67 73 0a 20 20 20 20 70 72 6f 63 20 hangs. proc
7dc0: 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d count_to_eof {s}
7dd0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
7de0: 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 done timer..set
7df0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 l [gets $s]..if
7e00: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
7e10: 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 incr count..
7e20: 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 if {$count >
7e30: 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 9} {...close $s.
7e40: 09 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a ..set done true.
7e50: 09 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 ..set count {eof
7e60: 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 is sticky}...af
7e70: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
7e80: 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 r.. }..}.
7e90: 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 72 }. proc timer
7ea0: 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 proc {} {..globa
7eb0: 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 l done count c..
7ec0: 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 set done true..s
7ed0: 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 et count {timer
7ee0: 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 went off, eof is
7ef0: 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c not sticky}..cl
7f00: 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 0a 20 20 ose $c. }..
7f10: 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 set count 0.
7f20: 20 20 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 set done false
7f30: 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 5f . proc write_
7f40: 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b then_close {s} {
7f50: 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 ..puts $s bye..c
7f60: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
7f70: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
7f80: 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 a p} {..fconfig
7f90: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
7fa0: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
7fb0: 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e ion lf..fileeven
7fc0: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 77 t $s writable "w
7fd0: 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 rite_then_close
7fe0: 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s". }. se
7ff0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
8000: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \..-certfile $s
8010: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
8020: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8030: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8040: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
8050: 65 70 74 20 38 38 33 33 5d 0a 20 20 20 20 73 65 ept 8833]. se
8060: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
8070: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
8080: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
8090: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
80a0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
80b0: 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e .[info hostn
80c0: 61 6d 65 5d 20 38 38 33 33 5d 0a 20 20 20 20 66 ame] 8833]. f
80d0: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
80e0: 6f 63 6b 69 6e 67 20 6f 66 66 20 2d 62 75 66 66 ocking off -buff
80f0: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
8100: 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 slation lf. f
8110: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
8120: 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 able "count_to_e
8130: 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 of $c". set t
8140: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
8150: 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 timerproc].
8160: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 vwait done. c
8170: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
8180: 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 count.} {eof is
8190: 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 sticky}..removeF
81a0: 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 74 ile script..test
81b0: 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 tlsIO-10.1 {tes
81c0: 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 63 65 ting socket acce
81d0: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
81e0: 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 r handling} {soc
81f0: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 ket} {. set g
8200: 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 72 oterror 0. pr
8210: 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 oc bgerror args
8220: 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 {global goterror
8230: 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 31 ; set goterror 1
8240: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
8250: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
8260: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
8270: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8280: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
8290: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
82a0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 39 38 rver accept 8898
82b0: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
82c0: 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 t {s a p} {close
82d0: 20 24 73 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 $s; error}.
82e0: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
82f0: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
8300: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
8310: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8320: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
8330: 5c 0a 09 31 32 37 2e 30 2e 30 2e 31 20 38 38 39 \..127.0.0.1 889
8340: 38 5d 0a 20 20 20 20 76 77 61 69 74 20 67 6f 74 8]. vwait got
8350: 65 72 72 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 error. close
8360: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a $s. close $c.
8370: 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 set goterror
8380: 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f .} 1..test tlsIO
8390: 2d 31 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 -11.1 {tcp conne
83a0: 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 ction} {socket d
83b0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
83c0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
83d0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
83e0: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
83f0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8400: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
8410: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
8420: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8430: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
8440: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
8450: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
8460: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
8470: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
8480: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
8490: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
84a0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
84b0: 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 31 5f ..set socket9_1_
84c0: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
84d0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
84e0: 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 accept \...-cer
84f0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
8500: 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 t \...-cafile $c
8510: 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 aCert \...-keyfi
8520: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8530: 09 09 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 ..8834]..proc ac
8540: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
8550: 20 20 20 20 70 75 74 73 20 24 73 20 64 6f 6e 65 puts $s done
8560: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
8570: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 63 6c 6f hake $s.. clo
8580: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
8590: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
85a0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
85b0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
85c0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
85d0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
85e0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
85f0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
8600: 33 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 34]. set r [g
8610: 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ets $s]. clos
8620: 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d e $s. sendCom
8630: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
8640: 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 ket9_1_test_serv
8650: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
8660: 64 6f 6e 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f done..test tlsIO
8670: 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 -11.2 {client sp
8680: 65 63 69 66 69 65 73 20 69 74 73 20 70 6f 72 74 ecifies its port
8690: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
86a0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
86b0: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d r} {. sendCom
86c0: 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 mand "set caCert
86d0: 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 $caCert". se
86e0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
86f0: 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 erverCert $serve
8700: 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 rCert". sendC
8710: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
8720: 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 ntCert $clientCe
8730: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8740: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b and "set serverK
8750: 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 ey $serverKey".
8760: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8770: 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 set clientKey $c
8780: 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 69 66 lientKey". if
8790: 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 {[info exists p
87a0: 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 6f ort]} {..incr po
87b0: 72 74 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a rt. } else {.
87c0: 09 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 .set port [expr
87d0: 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 2b $tlsServerPort +
87e0: 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 [pid]%1024].
87f0: 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }. sendComma
8800: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
8810: 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 9_2_test_server
8820: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
8830: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 rver accept \...
8840: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
8850: 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c rCert \...-cafil
8860: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b e $caCert \...-k
8870: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
8880: 79 20 5c 0a 09 20 20 20 20 38 38 33 35 5d 0a 09 y \.. 8835]..
8890: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
88a0: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
88b0: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
88c0: 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 puts $s $p..
88d0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
88e0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
88f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
8900: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
8910: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8920: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8930: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8940: 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 -myport $port
8950: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
8960: 20 38 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 8835]. set r
8970: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
8980: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 lose $s. send
8990: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
89a0: 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 socket9_2_test_s
89b0: 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 erver}. if {$
89c0: 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 r == $port} {..s
89d0: 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 et result ok.
89e0: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 } else {..set r
89f0: 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 esult broken.
8a00: 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c }. set resul
8a10: 74 0a 7d 20 6f 6b 0a 74 65 73 74 20 74 6c 73 49 t.} ok.test tlsI
8a20: 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 O-11.3 {trying t
8a30: 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 o connect, no se
8a40: 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f rver} {socket do
8a50: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8a60: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 erver} {. set
8a70: 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 status ok. i
8a80: 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 f {![catch {set
8a90: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
8aa0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8ab0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
8ac0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8ad0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
8ae0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
8af0: 72 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d 20 rverIp 8836]}]}
8b00: 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b {..if {![catch {
8b10: 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 gets $s}]} {..
8b20: 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f set status bro
8b30: 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 ken..}..close $s
8b40: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
8b50: 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 tatus.} ok..test
8b60: 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d tlsIO-11.4 {rem
8b70: 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 ote echo, one li
8b80: 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ne} {socket doTe
8b90: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
8ba0: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
8bb0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 ommand "set caCe
8bc0: 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 rt $caCert".
8bd0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8be0: 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 serverCert $ser
8bf0: 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e verCert". sen
8c00: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
8c10: 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 ientCert $client
8c20: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
8c30: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
8c40: 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 rKey $serverKey"
8c50: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8c60: 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 "set clientKey
8c70: 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 $clientKey".
8c80: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 20 20 sendCommand {.
8c90: 20 20 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 .global server
8ca0: 43 65 72 74 0a 09 67 6c 6f 62 61 6c 20 63 61 43 Cert..global caC
8cb0: 65 72 74 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 ert..global serv
8cc0: 65 72 4b 65 79 0a 09 73 65 74 20 73 6f 63 6b 65 erKey..set socke
8cd0: 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 t10_6_test_serve
8ce0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
8cf0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
8d00: 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 rverCert \...-ca
8d10: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
8d20: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
8d30: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
8d40: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 accept 8836]..p
8d50: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
8d60: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
8d70: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
8d80: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
8d90: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
8da0: 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 o $s].. fconf
8db0: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
8dc0: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
8dd0: 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 ation crlf..}..p
8de0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
8df0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
8e00: 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f $s].. if {[eo
8e10: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
8e20: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 $s.. } else
8e30: 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 {...puts $s $l..
8e40: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
8e50: 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 set f [tls::s
8e60: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8e70: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
8e80: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8e90: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
8ea0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
8eb0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
8ec0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
8ed0: 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 re $f -translati
8ee0: 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 on crlf -bufferi
8ef0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 ng line. puts
8f00: 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 $f hello. se
8f10: 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t r [gets $f].
8f20: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
8f30: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
8f40: 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 e $socket10_6_te
8f50: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
8f60: 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 et r.} hello..te
8f70: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 st tlsIO-11.5 {r
8f80: 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c emote echo, 50 l
8f90: 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ines} {socket do
8fa0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8fb0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
8fc0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 dCommand "set ca
8fd0: 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 Cert $caCert".
8fe0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8ff0: 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 et serverCert $s
9000: 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 erverCert". s
9010: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
9020: 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 clientCert $clie
9030: 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 ntCert". send
9040: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
9050: 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 verKey $serverKe
9060: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
9070: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 nd "set clientKe
9080: 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 y $clientKey".
9090: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
90a0: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f .set socket10_7_
90b0: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
90c0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
90d0: 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 accept \...-cer
90e0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
90f0: 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 t \...-cafile $c
9100: 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 aCert \...-keyfi
9110: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
9120: 09 09 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 ..8836]..proc ac
9130: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
9140: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
9150: 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 ke $s.. filee
9160: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
9170: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
9180: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9190: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
91a0: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
91b0: 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 crlf..}..proc ec
91c0: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 ho {s} {.. se
91d0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 t l [gets $s]..
91e0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
91f0: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 {...close $s..
9200: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 } else {...pu
9210: 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a ts $s $l.. }.
9220: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
9230: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
9240: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9250: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9260: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9270: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9280: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9290: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
92a0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 fconfigure $f
92b0: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
92c0: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
92d0: 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 e. for {set c
92e0: 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 nt 0} {$cnt < 50
92f0: 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 } {incr cnt} {..
9300: 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 puts $f "hello,
9310: 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 69 $cnt"..if {[stri
9320: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 73 ng compare [gets
9330: 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 6e $f] "hello, $cn
9340: 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 t"] != 0} {..
9350: 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a break..}. }.
9360: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
9370: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
9380: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f ose $socket10_7_
9390: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
93a0: 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 set cnt.} 50..#
93b0: 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 Macintosh socke
93c0: 74 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 ts can have more
93d0: 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 than one server
93e0: 20 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 per port.if {$t
93f0: 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 cl_platform(plat
9400: 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e 74 form) == "macint
9410: 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 osh"} {. set
9420: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b conflictResult {
9430: 30 20 38 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0 8836}.} else {
9440: 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 . set conflic
9450: 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c tResult {1 {coul
9460: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
9470: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
9480: 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 y in use}}.}..te
9490: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 st tlsIO-11.6 {s
94a0: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
94b0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
94c0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
94d0: 20 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 {. set s1 [t
94e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
94f0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
9500: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
9510: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9520: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
9530: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
9540: 74 20 38 38 33 36 5d 0a 20 20 20 20 69 66 20 7b t 8836]. if {
9550: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b [catch {set s2 [
9560: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9570: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
9580: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9590: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
95a0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
95b0: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
95c0: 70 74 20 38 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 pt 8836]} msg]}
95d0: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c {..set result [l
95e0: 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 ist 1 $msg].
95f0: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 } else {..set re
9600: 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 sult [list 0 [li
9610: 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 ndex [fconfigure
9620: 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 $s2 -sockname]
9630: 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 2]]..close $s2.
9640: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
9650: 73 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c s1. set resul
9660: 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 t.} $conflictRes
9670: 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ult..test tlsIO-
9680: 31 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 11.7 {server wit
9690: 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 h several client
96a0: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
96b0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
96c0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
96d0: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
96e0: 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 ket10_9_test_ser
96f0: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
9700: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 5b \...-certfile [
9710: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9720: 63 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 6d certs server.pem
9730: 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 ] \...-cafile [f
9740: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9750: 65 72 74 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d erts caFile.pem]
9760: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 \...-keyfile [f
9770: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9780: 65 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c erts skey.pem] \
9790: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
97a0: 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 8836]..proc ac
97b0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
97c0: 20 20 20 20 23 20 68 61 6e 64 73 68 61 6b 65 20 # handshake
97d0: 6c 6f 63 6b 73 20 75 70 20 74 68 65 20 74 68 72 locks up the thr
97e0: 65 65 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 63 ee synchronous c
97f0: 6c 69 65 6e 74 73 0a 09 20 20 20 20 23 20 74 6c lients.. # tl
9800: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
9810: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9820: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
9830: 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e ne.. fileeven
9840: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
9850: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a ist echo $s]..}.
9860: 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b .proc echo {s} {
9870: 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 .. set l [get
9880: 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b s $s].. if {[
9890: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f eof $s]} {...clo
98a0: 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 se $s.. } els
98b0: 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c e {...puts $s $l
98c0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
98d0: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
98e0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
98f0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
9900: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
9910: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9920: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9930: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9940: 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 8836]. fconf
9950: 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 igure $s1 -buffe
9960: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
9970: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
9980: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
9990: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
99a0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
99b0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
99c0: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
99d0: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
99e0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
99f0: 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s2 -buffering li
9a00: 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 ne. set s3 [t
9a10: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9a20: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9a30: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9a40: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9a50: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9a60: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9a70: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 8836]. fco
9a80: 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 nfigure $s3 -buf
9a90: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
9aa0: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
9ab0: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
9ac0: 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 } {..puts $s1 he
9ad0: 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 llo,s1..gets $s1
9ae0: 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f ..puts $s2 hello
9af0: 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 ,s2..gets $s2..p
9b00: 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 uts $s3 hello,s3
9b10: 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d ..gets $s3. }
9b20: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
9b30: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
9b40: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 close $s3. s
9b50: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
9b60: 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 e $socket10_9_te
9b70: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
9b80: 65 74 20 69 0a 7d 20 31 30 30 20 20 20 20 0a 0a et i.} 100 ..
9b90: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 38 20 test tlsIO-11.8
9ba0: 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 73 65 76 {client with sev
9bb0: 65 72 61 6c 20 73 65 72 76 65 72 73 7d 20 7b 75 eral servers} {u
9bc0: 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 nexplainedHang s
9bd0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9be0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9bf0: 0a 20 20 20 20 23 20 74 68 69 73 20 6f 6e 65 20 . # this one
9c00: 73 65 65 6d 73 20 74 6f 20 68 61 6e 67 20 2d 2d seems to hang --
9c10: 20 61 77 62 20 36 2f 32 2f 32 30 30 30 0a 20 20 awb 6/2/2000.
9c20: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
9c30: 09 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f .set s1 [tls::so
9c40: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
9c50: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
9c60: 77 64 5d 20 63 65 72 74 73 20 73 65 72 76 65 72 wd] certs server
9c70: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 6c .pem] \...-cafil
9c80: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
9c90: 64 5d 20 63 65 72 74 73 20 63 61 46 69 6c 65 2e d] certs caFile.
9ca0: 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 6c pem] \...-keyfil
9cb0: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
9cc0: 64 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 65 d] certs skey.pe
9cd0: 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 22 m] \...-server "
9ce0: 61 63 63 65 70 74 20 34 30 30 33 22 20 34 30 30 accept 4003" 400
9cf0: 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3]..set s2 [tls:
9d00: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
9d10: 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e tfile [file join
9d20: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 65 72 [pwd] certs ser
9d30: 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 ver.pem] \...-ca
9d40: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
9d50: 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 46 69 [pwd] certs caFi
9d60: 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 le.pem] \...-key
9d70: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
9d80: 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b 65 79 [pwd] certs skey
9d90: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 .pem] \...-serve
9da0: 72 20 22 61 63 63 65 70 74 20 34 30 30 34 22 20 r "accept 4004"
9db0: 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 4004]..set s3 [t
9dc0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
9dd0: 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a certfile [file j
9de0: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9df0: 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 server.pem] \...
9e00: 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f -cafile [file jo
9e10: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 in [pwd] certs c
9e20: 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d aFile.pem] \...-
9e30: 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f keyfile [file jo
9e40: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 in [pwd] certs s
9e50: 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 key.pem] \...-se
9e60: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
9e70: 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 20 61 5" 4005]..proc a
9e80: 63 63 65 70 74 20 7b 6d 70 20 73 20 61 20 70 7d ccept {mp s a p}
9e90: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
9ea0: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 70 dshake $s.. p
9eb0: 75 74 73 20 24 73 20 24 6d 70 0a 09 20 20 20 20 uts $s $mp..
9ec0: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
9ed0: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
9ee0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9ef0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
9f00: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
9f10: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9f20: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
9f30: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
9f40: 50 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 20 P 4003]. set
9f50: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
9f60: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9f70: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9f80: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9f90: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9fa0: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9fb0: 65 72 76 65 72 49 50 20 34 30 30 34 5d 0a 20 20 erverIP 4004].
9fc0: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
9fd0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9fe0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9ff0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
a000: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
a010: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
a020: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 emoteServerIP 40
a030: 30 35 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 05]. set l ""
a040: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
a050: 67 65 74 73 20 24 73 31 5d 20 5b 67 65 74 73 20 gets $s1] [gets
a060: 24 73 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b $s1] [eof $s1] [
a070: 67 65 74 73 20 24 73 32 5d 20 5b 67 65 74 73 20 gets $s2] [gets
a080: 24 73 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c $s2] [eof $s2] \
a090: 0a 09 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 65 ..[gets $s3] [ge
a0a0: 74 73 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 ts $s3] [eof $s3
a0b0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a ]. close $s1.
a0c0: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
a0d0: 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 close $s3.
a0e0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 sendCommand {..c
a0f0: 6c 6f 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 lose $s1..close
a100: 24 73 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 $s2..close $s3.
a110: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d }. set l.}
a120: 20 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 34 {4003 {} 1 4004
a130: 20 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 7d {} 1 4005 {} 1}
a140: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
a150: 39 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 9 {accept callba
a160: 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 ck error} {socke
a170: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
a180: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
a190: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
a1a0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
a1b0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
a1c0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
a1d0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
a1e0: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
a1f0: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d ver accept 8836]
a200: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
a210: 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 {s a p} {expr 1
a220: 30 20 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 0 / 0}. proc
a230: 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 bgerror args {..
a240: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
a250: 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 $args. }.
a260: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a270: 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 caCert $caCert"
a280: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a290: 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 "set serverCert
a2a0: 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 $serverCert".
a2b0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
a2c0: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 et clientCert $c
a2d0: 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 lientCert". s
a2e0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
a2f0: 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 serverKey $serve
a300: 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f rKey". sendCo
a310: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
a320: 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 tKey $clientKey"
a330: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
a340: 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 {sendCommand {..
a350: 20 20 20 20 73 65 74 20 70 65 65 72 6e 61 6d 65 set peername
a360: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 63 61 [fconfigure $ca
a370: 6c 6c 65 72 53 6f 63 6b 65 74 20 2d 70 65 65 72 llerSocket -peer
a380: 6e 61 6d 65 5d 0a 09 20 20 20 20 73 65 74 20 73 name].. set s
a390: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
a3a0: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
a3b0: 65 6e 74 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 entCert \...-caf
a3c0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 ile $caCert \...
a3d0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a3e0: 4b 65 79 20 5c 0a 09 20 20 20 20 09 5b 6c 69 6e Key \.. .[lin
a3f0: 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d dex $peername 0]
a400: 20 38 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 8836].. clos
a410: 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 e $s. . }} ms
a420: 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a g]} {..close $s.
a430: 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 .error $msg.
a440: 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 }. set timer
a450: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
a460: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
a470: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
a480: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
a490: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
a4a0: 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 . rename bger
a4b0: 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 ror {}. set x
a4c0: 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a .} {{divide by z
a4d0: 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ero}}..test tlsI
a4e0: 4f 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 O-11.10 {testing
a4f0: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
a500: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
a510: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
a520: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
a530: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
a540: 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 t caCert $caCert
a550: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a560: 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 d "set serverCer
a570: 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 t $serverCert".
a580: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a590: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 set clientCert $
a5a0: 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 clientCert".
a5b0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a5c0: 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 serverKey $serv
a5d0: 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 erKey". sendC
a5e0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
a5f0: 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 ntKey $clientKey
a600: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a610: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
a620: 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 0_12_test_server
a630: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
a640: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
a650: 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 verCert \...-caf
a660: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 ile $caCert \...
a670: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
a680: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
a690: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 accept 8836]..pr
a6a0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
a6b0: 7d 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 } {close $s}.
a6c0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
a6d0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
a6e0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
a6f0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
a700: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a710: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
a720: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
a730: 50 20 38 38 33 36 5d 0a 20 20 20 20 73 65 74 20 P 8836]. set
a740: 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 p [fconfigure $s
a750: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 -peername].
a760: 73 65 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 set n [fconfigur
a770: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
a780: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
a790: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 lappend l [lind
a7a0: 65 78 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 ex $p 2] [llengt
a7b0: 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 h $p] [llength $
a7c0: 70 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a p]. close $s.
a7d0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a7e0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
a7f0: 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _12_test_server}
a800: 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 38 38 . set l.} {88
a810: 33 36 20 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 36 3 3}..test tl
a820: 73 49 4f 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 sIO-11.11 {testi
a830: 6e 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 6e ng spurious even
a840: 74 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 ts} {unexplained
a850: 48 61 6e 67 20 73 6f 63 6b 65 74 20 64 6f 54 65 Hang socket doTe
a860: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
a870: 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 68 61 6e ver} {. # han
a880: 67 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 gs. sendComma
a890: 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 nd "set caCert $
a8a0: 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 caCert". send
a8b0: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
a8c0: 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 verCert $serverC
a8d0: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a8e0: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
a8f0: 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 Cert $clientCert
a900: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a910: 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 d "set serverKey
a920: 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 $serverKey".
a930: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
a940: 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 t clientKey $cli
a950: 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 entKey". send
a960: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
a970: 6f 63 6b 65 74 31 30 5f 31 33 5f 74 65 73 74 5f ocket10_13_test_
a980: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
a990: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
a9a0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
a9b0: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
a9c0: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
a9d0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
a9e0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
a9f0: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
aa00: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
aa10: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
aa20: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
aa30: 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e $s -translation
aa40: 20 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 20 20 "auto lf"..
aa50: 61 66 74 65 72 20 31 30 30 20 77 72 69 74 65 73 after 100 writes
aa60: 6f 6d 65 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 ome $s..}..proc
aa70: 77 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a writesome {s} {.
aa80: 09 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
aa90: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
aaa0: 6e 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 ncr i} {...puts
aab0: 24 73 20 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d $s "line $i from
aac0: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 22 0a remote server".
aad0: 09 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 . }.. clos
aae0: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
aaf0: 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 set len 0.
ab00: 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 set spurious 0.
ab10: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
ab20: 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c proc readlittl
ab30: 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 e {s} {..global
ab40: 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 spurious done le
ab50: 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 n..set l [read $
ab60: 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e s 1]..if {[strin
ab70: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 g length $l] ==
ab80: 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 0} {.. if {![
ab90: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 eof $s]} {...inc
aba0: 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 r spurious..
abb0: 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 } else {...close
abc0: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 $s...set done 1
abd0: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
abe0: 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 {.. incr len
abf0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
ac00: 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 l]..}. }.
ac10: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
ac20: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
ac30: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
ac40: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
ac50: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
ac60: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
ac70: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
ac80: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
ac90: 63 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 c readable "read
aca0: 6c 69 74 74 6c 65 20 24 63 22 0a 20 20 20 20 73 little $c". s
acb0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
acc0: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
acd0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
ace0: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
acf0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
ad00: 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 er. sendComma
ad10: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
ad20: 74 31 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 t10_13_test_serv
ad30: 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 er}. list $sp
ad40: 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 urious $len.} {0
ad50: 20 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 2690}..test tls
ad60: 49 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e IO-11.12 {testin
ad70: 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 g EOF stickyness
ad80: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
ad90: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
ada0: 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 75 r} {. set cou
adb0: 6e 74 65 72 20 30 0a 20 20 20 20 73 65 74 20 64 nter 0. set d
adc0: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 63 one 0. proc c
add0: 6f 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 ount_up {s} {..g
ade0: 6c 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f lobal counter do
adf0: 6e 65 20 61 66 74 65 72 5f 69 64 0a 09 73 65 74 ne after_id..set
ae00: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 l [gets $s]..if
ae10: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
ae20: 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a incr counter.
ae30: 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 . if {$counte
ae40: 72 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 r > 9} {...set d
ae50: 6f 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 69 63 one {EOF is stic
ae60: 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 ky}...after canc
ae70: 65 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 09 63 el $after_id...c
ae80: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 lose $s.. }..
ae90: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
aea0: 20 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a timed_out {} {.
aeb0: 09 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 .global c done..
aec0: 73 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f set done {timed_
aed0: 6f 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 out, EOF is not
aee0: 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 sticky}..close $
aef0: 63 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 c. }. send
af00: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 Command "set caC
af10: 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 ert $caCert".
af20: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
af30: 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 t serverCert $se
af40: 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 rverCert". se
af50: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
af60: 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e lientCert $clien
af70: 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 tCert". sendC
af80: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
af90: 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 erKey $serverKey
afa0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
afb0: 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 d "set clientKey
afc0: 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 $clientKey".
afd0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
afe0: 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 34 5f set socket10_14_
aff0: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
b000: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 ::socket \...-ce
b010: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
b020: 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 rt \...-cafile $
b030: 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 caCert \...-keyf
b040: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
b050: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
b060: 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 8836]..proc ac
b070: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
b080: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
b090: 6b 65 20 24 73 0a 09 20 20 20 20 61 66 74 65 72 ke $s.. after
b0a0: 20 31 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 7d 100 close $s..}
b0b0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 . }. set c
b0c0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
b0d0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
b0e0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
b0f0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
b100: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
b110: 0a 20 20 20 20 09 24 72 65 6d 6f 74 65 53 65 72 . .$remoteSer
b120: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
b130: 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 fileevent $c rea
b140: 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 20 dable "count_up
b150: 24 63 22 0a 20 20 20 20 73 65 74 20 61 66 74 65 $c". set afte
b160: 72 5f 69 64 20 5b 61 66 74 65 72 20 31 30 30 30 r_id [after 1000
b170: 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 20 timed_out].
b180: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 73 vwait done. s
b190: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
b1a0: 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 e $socket10_14_t
b1b0: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
b1c0: 73 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 set done.} {EOF
b1d0: 69 73 20 73 74 69 63 6b 79 7d 0a 0a 74 65 73 74 is sticky}..test
b1e0: 20 74 6c 73 49 4f 2d 31 31 2e 31 33 20 7b 74 65 tlsIO-11.13 {te
b1f0: 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 sting async writ
b200: 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 2c 20 e, async flush,
b210: 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 async close} \..
b220: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
b230: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
b240: 20 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 {. proc read
b250: 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c it {s} {..global
b260: 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 count done..set
b270: 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e l [read $s]..in
b280: 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 cr count [string
b290: 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 length $l]..if
b2a0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
b2b0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 close $s..
b2c0: 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 set done 1..}.
b2d0: 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d }. sendComm
b2e0: 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 and "set caCert
b2f0: 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e $caCert". sen
b300: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
b310: 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 rverCert $server
b320: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
b330: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
b340: 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 tCert $clientCer
b350: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
b360: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 nd "set serverKe
b370: 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 y $serverKey".
b380: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
b390: 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c et clientKey $cl
b3a0: 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e ientKey". sen
b3b0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
b3c0: 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a 09 66 firstblock ""..f
b3d0: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
b3e0: 20 3c 20 35 7d 20 7b 69 6e 63 72 20 69 7d 20 7b < 5} {incr i} {
b3f0: 0a 09 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 ...set firstbloc
b400: 6b 20 22 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 k "a$firstblock$
b410: 66 69 72 73 74 62 6c 6f 63 6b 22 0a 09 7d 0a 09 firstblock"..}..
b420: 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 set secondblock
b430: 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 ""..for {set i 0
b440: 7d 20 7b 24 69 20 3c 20 31 36 7d 20 7b 69 6e 63 } {$i < 16} {inc
b450: 72 20 69 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 r i} {.. set
b460: 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 secondblock "b$s
b470: 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e econdblock$secon
b480: 64 62 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 dblock"..}..set
b490: 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c l [tls::socket \
b4a0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
b4b0: 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 rverCert \...-ca
b4c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
b4d0: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
b4e0: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
b4f0: 20 61 63 63 65 70 74 20 38 38 34 35 5d 0a 09 70 accept 8845]..p
b500: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
b510: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
b520: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
b530: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
b540: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
b550: 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 slation lf -buff
b560: 65 72 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 ersize 16384 \..
b570: 09 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 .-buffering line
b580: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
b590: 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $s readable "rea
b5a0: 64 61 62 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 dable $s"..}..pr
b5b0: 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 oc readable {s}
b5c0: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
b5d0: 74 73 20 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 ts $s].. file
b5e0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
b5f0: 65 20 7b 7d 0a 09 20 20 20 20 61 66 74 65 72 20 e {}.. after
b600: 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 1000 respond $s.
b610: 09 7d 0a 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 .}..proc respond
b620: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 {s} {.. glob
b630: 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 al firstblock..
b640: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
b650: 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 ne $s $firstbloc
b660: 6b 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 k.. after 100
b670: 30 20 77 72 69 74 65 64 61 74 61 20 24 73 0a 09 0 writedata $s..
b680: 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 64 61 74 }..proc writedat
b690: 61 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f a {s} {.. glo
b6a0: 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a bal secondblock.
b6b0: 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
b6c0: 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 line $s $secondb
b6d0: 6c 6f 63 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 lock.. close
b6e0: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
b6f0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
b700: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
b710: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
b720: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
b730: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
b740: 4b 65 79 20 5c 0a 20 20 20 20 09 24 72 65 6d 6f Key \. .$remo
b750: 74 65 53 65 72 76 65 72 49 50 20 38 38 34 35 5d teServerIP 8845]
b760: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
b770: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $s -blocking 0 -
b780: 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 trans lf -buffer
b790: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
b7a0: 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 count 0. put
b7b0: 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 s $s hello. f
b7c0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
b7d0: 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 able "readit $s"
b7e0: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
b7f0: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
b800: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
b810: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
b820: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
b830: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e l $timer. sen
b840: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
b850: 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e $l}. set coun
b860: 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 t.} 65566..test
b870: 74 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 65 73 74 tlsIO-12.1 {test
b880: 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 ing inheritance
b890: 6f 66 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 of server socket
b8a0: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f s} \..{socket do
b8b0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
b8c0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d erver} {. rem
b8d0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
b8e0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
b8f0: 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 cript2.. # Sc
b900: 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 ript1 is just a
b910: 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 10 second delay.
b920: 20 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 If the server
b930: 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 socket. # is
b940: 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 inherited, it wi
b950: 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 ll be held open
b960: 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a for 10 seconds..
b970: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
b980: 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 script1 w]. p
b990: 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 uts $f {..after
b9a0: 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 10000 exit..vwai
b9b0: 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a t forever. }.
b9c0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
b9d0: 20 20 23 20 53 63 72 69 70 74 32 20 63 72 65 61 # Script2 crea
b9e0: 74 65 73 20 74 68 65 20 73 65 72 76 65 72 20 73 tes the server s
b9f0: 6f 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 ocket, launches
ba00: 73 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 script1,. # w
ba10: 61 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 aits a second, a
ba20: 6e 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 nd exits. The s
ba30: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c erver socket wil
ba40: 6c 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 l now. # be c
ba50: 6c 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 losed unless scr
ba60: 69 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 ipt1 inherited i
ba70: 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f t... set f [o
ba80: 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 pen script2 w].
ba90: 20 20 20 23 20 70 75 74 73 20 24 66 20 5b 6c 69 # puts $f [li
baa0: 73 74 20 73 65 74 20 74 63 6c 74 65 73 74 20 24 st set tcltest $
bab0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
bac0: 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 st]. puts $f
bad0: 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 [list set tclsh
bae0: 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 [info nameofexec
baf0: 75 74 61 62 6c 65 5d 5d 0a 20 20 20 20 70 75 74 utable]]. put
bb00: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
bb10: 72 65 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a require tcltest.
bb20: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
bb30: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
bb40: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
bb50: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
bb60: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
bb70: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
bb80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
bb90: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
bba0: 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 rKey 8828 \]".
bbb0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
bbc0: 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 c accept { file
bbd0: 61 64 64 72 20 70 6f 72 74 20 7d 20 7b 0a 09 20 addr port } {..
bbe0: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
bbf0: 7d 0a 09 23 20 65 78 65 63 20 24 3a 3a 74 63 6c }..# exec $::tcl
bc00: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
bc10: 72 69 70 74 31 20 26 0a 09 65 78 65 63 20 24 74 ript1 &..exec $t
bc20: 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 clsh script1 &..
bc30: 63 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 72 20 close $f..after
bc40: 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 1000 exit..vwait
bc50: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
bc60: 20 20 20 63 6c 6f 73 65 20 24 66 0a 09 0a 20 20 close $f...
bc70: 20 20 23 20 4c 61 75 6e 63 68 20 73 63 72 69 70 # Launch scrip
bc80: 74 32 20 61 6e 64 20 77 61 69 74 20 35 20 73 65 t2 and wait 5 se
bc90: 63 6f 6e 64 73 0a 0a 20 20 20 20 23 20 65 78 65 conds.. # exe
bca0: 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 c $::tcltest::tc
bcb0: 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a ltest script2 &.
bcc0: 20 20 20 20 65 78 65 63 20 5b 69 6e 66 6f 20 6e exec [info n
bcd0: 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d ameofexecutable]
bce0: 20 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 61 script2 &. a
bcf0: 66 74 65 72 20 35 30 30 30 20 7b 20 73 65 74 20 fter 5000 { set
bd00: 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 20 ok_to_proceed 1
bd10: 7d 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 }. vwait ok_t
bd20: 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 23 o_proceed.. #
bd30: 20 49 66 20 77 65 20 63 61 6e 20 73 74 69 6c 6c If we can still
bd40: 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 20 connect to the
bd50: 73 65 72 76 65 72 2c 20 74 68 65 20 73 6f 63 6b server, the sock
bd60: 65 74 20 67 6f 74 20 69 6e 68 65 72 69 74 65 64 et got inherited
bd70: 2e 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 ... if {[catc
bd80: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c h {tls::socket \
bd90: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
bda0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
bdb0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
bdc0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 $clientKey \.
bdd0: 20 09 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 . 127.0.0.1 882
bde0: 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 8} msg]} {..set
bdf0: 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 x {server socket
be00: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
be10: 65 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ed}. } else {
be20: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 73 65 ..close $msg..se
be30: 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b t x {server sock
be40: 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 et was inherited
be50: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 72 65 6d }. }.. rem
be60: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
be70: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
be80: 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 cript2. set x
be90: 0a 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 .} {server socke
bea0: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
beb0: 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f ted}..test tlsIO
bec0: 2d 31 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 69 -12.2 {testing i
bed0: 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 63 6c nheritance of cl
bee0: 69 65 6e 74 20 73 6f 63 6b 65 74 73 7d 20 5c 0a ient sockets} \.
bef0: 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 .{socket doTests
bf00: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
bf10: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
bf20: 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 le script1. r
bf30: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
bf40: 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 2.. # Script1
bf50: 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 is just a 10 se
bf60: 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 cond delay. If
bf70: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
bf80: 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 t. # is inher
bf90: 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 ited, it will be
bfa0: 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 held open for 1
bfb0: 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 0 seconds.. s
bfc0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
bfd0: 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t1 w]. puts $
bfe0: 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 f {..after 10000
bff0: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
c000: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
c010: 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 lose $f.. # S
c020: 63 72 69 70 74 32 20 6f 70 65 6e 73 20 74 68 65 cript2 opens the
c030: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 61 client socket a
c040: 6e 64 20 77 72 69 74 65 73 20 74 6f 20 69 74 2e nd writes to it.
c050: 20 20 49 74 20 74 68 65 6e 0a 20 20 20 20 23 20 It then. #
c060: 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 launches script1
c070: 20 61 6e 64 20 65 78 69 74 73 2e 20 20 49 66 20 and exits. If
c080: 74 68 65 20 63 68 69 6c 64 20 70 72 6f 63 65 73 the child proces
c090: 73 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 0a s inherited the.
c0a0: 20 20 20 20 23 20 63 6c 69 65 6e 74 20 73 6f 63 # client soc
c0b0: 6b 65 74 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 ket, the socket
c0c0: 77 69 6c 6c 20 73 74 69 6c 6c 20 62 65 20 6f 70 will still be op
c0d0: 65 6e 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b en... set f [
c0e0: 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a open script2 w].
c0f0: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
c100: 74 20 73 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 t set tclsh [inf
c110: 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 o nameofexecutab
c120: 6c 65 5d 5d 0a 20 20 20 20 70 75 74 73 20 24 66 le]]. puts $f
c130: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
c140: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
c150: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
c160: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
c170: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
c180: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
c190: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
c1a0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
c1b0: 2e 30 2e 30 2e 31 20 38 38 32 39 20 5c 5d 22 0a .0.0.1 8829 \]".
c1c0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 puts $f {..e
c1d0: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
c1e0: 74 31 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 t1 &..puts $f te
c1f0: 73 74 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a sting..flush $f.
c200: 09 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 .after 1000 exit
c210: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
c220: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
c230: 24 66 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 $f.. # Create
c240: 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b the server sock
c250: 65 74 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 et.. set serv
c260: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
c270: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 \..-certfile $se
c280: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
c290: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
c2a0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
c2b0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
c2c0: 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 829]. proc ac
c2d0: 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 cept { file host
c2e0: 20 70 6f 72 74 20 7d 20 7b 0a 0a 09 23 20 57 68 port } {...# Wh
c2f0: 65 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 63 6f en the client co
c300: 6e 6e 65 63 74 73 2c 20 65 73 74 61 62 6c 69 73 nnects, establis
c310: 68 20 74 68 65 20 72 65 61 64 20 68 61 6e 64 6c h the read handl
c320: 65 72 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 er..global serve
c330: 72 0a 09 63 6c 6f 73 65 20 24 73 65 72 76 65 72 r..close $server
c340: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 66 69 6c ..fileevent $fil
c350: 65 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 e readable [list
c360: 20 67 65 74 64 61 74 61 20 24 66 69 6c 65 5d 0a getdata $file].
c370: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c .fconfigure $fil
c380: 65 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e e -buffering lin
c390: 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 72 e -blocking 0..r
c3a0: 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 eturn. }.
c3b0: 70 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 proc getdata { f
c3c0: 69 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 ile } {...# Read
c3d0: 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 handler on the
c3e0: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e accepted socket.
c3f0: 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 ..global x..glob
c400: 61 6c 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 al failed..set s
c410: 74 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 tatus [catch {re
c420: 61 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a ad $file} data].
c430: 09 69 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 .if {$status !=
c440: 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 0} {.. set x
c450: 7b 72 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 {read failed, er
c460: 72 6f 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 ror was $data}..
c470: 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 catch { clos
c480: 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 e $file }..} els
c490: 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d eif {[string com
c4a0: 70 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 pare {} $data]}
c4b0: 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 {..} elseif {[fb
c4c0: 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b locked $file]} {
c4d0: 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 ..} elseif {[eof
c4e0: 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 $file]} {..
c4f0: 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 if {$failed} {..
c500: 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 .set x {client s
c510: 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 ocket was inheri
c520: 74 65 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 ted}.. } else
c530: 20 7b 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 {...set x {clie
c540: 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f nt socket was no
c550: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 t inherited}..
c560: 20 20 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b }.. catch {
c570: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
c580: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 } else {.. se
c590: 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 t x {impossible
c5a0: 63 61 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 case}.. catch
c5b0: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
c5c0: 0a 09 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 ..}..return.
c5d0: 7d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 }.. # If the
c5e0: 73 6f 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 socket doesn't h
c5f0: 69 74 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 it end-of-file i
c600: 6e 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 n 5 seconds, the
c610: 0a 20 20 20 20 23 20 73 63 72 69 70 74 31 20 70 . # script1 p
c620: 72 6f 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 rocess must have
c630: 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 inherited the c
c640: 6c 69 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 lient... set
c650: 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 failed 0. aft
c660: 65 72 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 er 5000 [list se
c670: 74 20 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 t failed 1]..
c680: 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 # Launch the sc
c690: 72 69 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 ript2 process..
c6a0: 20 20 20 65 78 65 63 20 5b 69 6e 66 6f 20 6e 61 exec [info na
c6b0: 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 20 meofexecutable]
c6c0: 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 76 script2 &.. v
c6d0: 77 61 69 74 20 78 0a 20 20 20 20 69 66 20 7b 21 wait x. if {!
c6e0: 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 $failed} {..vwai
c6f0: 74 20 66 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 t failed. }.
c700: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
c710: 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 ript1. remove
c720: 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 File script2.
c730: 20 73 65 74 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 set x.} {client
c740: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
c750: 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 inherited}..test
c760: 20 74 6c 73 49 4f 2d 31 32 2e 33 20 7b 74 65 73 tlsIO-12.3 {tes
c770: 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 ting inheritance
c780: 20 6f 66 20 61 63 63 65 70 74 65 64 20 73 6f 63 of accepted soc
c790: 6b 65 74 73 7d 20 5c 0a 09 7b 68 61 6e 67 73 4f kets} \..{hangsO
c7a0: 6e 4c 69 6e 75 78 20 73 6f 63 6b 65 74 20 64 6f nLinux socket do
c7b0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
c7c0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 68 erver} {. # h
c7d0: 61 6e 67 73 20 6f 6e 20 4c 69 6e 75 78 0a 20 20 angs on Linux.
c7e0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
c7f0: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
c800: 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 ile script2..
c810: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
c820: 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt1 w]. puts
c830: 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 $f {..after 100
c840: 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 00 exit..vwait f
c850: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
c860: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 close $f.. s
c870: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
c880: 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t2 w]. puts $
c890: 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 f [list set tcls
c8a0: 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 h [info nameofex
c8b0: 65 63 75 74 61 62 6c 65 5d 5d 0a 20 20 20 20 70 ecutable]]. p
c8c0: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
c8d0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
c8e0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
c8f0: 20 24 66 20 22 63 61 74 63 68 20 7b 73 65 74 20 $f "catch {set
c900: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
c910: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
c920: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
c930: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c940: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
c950: 65 72 76 65 72 4b 65 79 20 38 39 33 30 20 5c 5d erverKey 8930 \]
c960: 7d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b }". puts $f {
c970: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 ..proc accept {
c980: 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d file host port }
c990: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 {.. global t
c9a0: 63 6c 73 68 0a 09 20 20 20 20 70 75 74 73 20 24 clsh.. puts $
c9b0: 66 69 6c 65 20 7b 74 65 73 74 20 64 61 74 61 20 file {test data
c9c0: 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 20 on socket}..
c9d0: 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 exec $tclsh scri
c9e0: 70 74 31 20 26 0a 09 20 20 20 20 61 66 74 65 72 pt1 &.. after
c9f0: 20 31 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 63 1000 exit..}..c
ca00: 61 74 63 68 20 7b 76 77 61 69 74 20 66 6f 72 65 atch {vwait fore
ca10: 76 65 72 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 ver}. }. c
ca20: 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 4c lose $f.. # L
ca30: 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 aunch the script
ca40: 32 20 70 72 6f 63 65 73 73 20 61 6e 64 20 63 6f 2 process and co
ca50: 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 53 65 nnect to it. Se
ca60: 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 23 e how long. #
ca70: 20 74 68 65 20 73 6f 63 6b 65 74 20 73 74 61 79 the socket stay
ca80: 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 65 63 s open.. exec
ca90: 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 [info nameofexe
caa0: 63 75 74 61 62 6c 65 5d 20 73 63 72 69 70 74 32 cutable] script2
cab0: 20 26 0a 0a 20 20 20 20 61 66 74 65 72 20 31 30 &.. after 10
cac0: 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 00 set ok_to_pro
cad0: 63 65 65 64 20 31 0a 20 20 20 20 76 77 61 69 74 ceed 1. vwait
cae0: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a ok_to_proceed..
caf0: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
cb00: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
cb10: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
cb20: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
cb30: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
cb40: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
cb50: 32 37 2e 30 2e 30 2e 31 20 38 39 33 30 5d 0a 20 27.0.0.1 8930].
cb60: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
cb70: 20 2d 62 75 66 66 65 72 69 6e 67 20 66 75 6c 6c -buffering full
cb80: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 -blocking 0.
cb90: 20 66 69 6c 65 65 76 65 6e 74 20 24 66 20 72 65 fileevent $f re
cba0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 adable [list get
cbb0: 64 61 74 61 20 24 66 5d 0a 0a 20 20 20 20 23 20 data $f].. #
cbc0: 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 69 73 If the socket is
cbd0: 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 still open afte
cbe0: 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 r 5 seconds, the
cbf0: 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 script1 process
cc00: 0a 20 20 20 20 23 20 6d 75 73 74 20 68 61 76 65 . # must have
cc10: 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 61 inherited the a
cc20: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a ccepted socket..
cc30: 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 . set failed
cc40: 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 0. after 5000
cc50: 20 73 65 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 set failed 1..
cc60: 20 20 20 70 72 6f 63 20 67 65 74 64 61 74 61 20 proc getdata
cc70: 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 { file } {...# R
cc80: 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 ead handler on t
cc90: 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 he client socket
cca0: 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f ...global x..glo
ccb0: 62 61 6c 20 66 61 69 6c 65 64 0a 09 73 65 74 20 bal failed..set
ccc0: 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72 status [catch {r
ccd0: 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d ead $file} data]
cce0: 0a 09 69 66 20 7b 24 73 74 61 74 75 73 20 21 3d ..if {$status !=
ccf0: 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 0} {.. set x
cd00: 20 7b 72 65 61 64 20 66 61 69 6c 65 64 2c 20 65 {read failed, e
cd10: 72 72 6f 72 20 77 61 73 20 24 64 61 74 61 7d 0a rror was $data}.
cd20: 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f . catch { clo
cd30: 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c se $file }..} el
cd40: 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f seif {[string co
cd50: 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d mpare {} $data]}
cd60: 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 {..} elseif {[f
cd70: 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 blocked $file]}
cd80: 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f {..} elseif {[eo
cd90: 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 f $file]} {..
cda0: 20 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a if {$failed} {.
cdb0: 09 09 73 65 74 20 78 20 7b 61 63 63 65 70 74 65 ..set x {accepte
cdc0: 64 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 d socket was inh
cdd0: 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 20 65 erited}.. } e
cde0: 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 lse {...set x {a
cdf0: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 ccepted socket w
ce00: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
ce10: 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 61 }.. }.. ca
ce20: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
ce30: 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 e }..} else {..
ce40: 20 20 20 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 set x {imposs
ce50: 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 20 20 ible case}..
ce60: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
ce70: 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e ile }..}..return
ce80: 0a 20 20 20 20 7d 0a 20 20 20 20 0a 20 20 20 20 . }. .
ce90: 76 77 61 69 74 20 78 0a 0a 20 20 20 20 72 65 6d vwait x.. rem
cea0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
ceb0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
cec0: 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 cript2. set x
ced0: 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 .} {accepted soc
cee0: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
cef0: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 rited}..test tls
cf00: 49 4f 2d 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 IO-13.1 {Testing
cf10: 20 75 73 65 20 6f 66 20 73 68 61 72 65 64 20 73 use of shared s
cf20: 6f 63 6b 65 74 20 62 65 74 77 65 65 6e 20 74 77 ocket between tw
cf30: 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 o threads} \..{s
cf40: 6f 63 6b 65 74 20 74 65 73 74 74 68 72 65 61 64 ocket testthread
cf50: 7d 20 7b 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 } {.. removeF
cf60: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 74 ile script. t
cf70: 68 72 65 61 64 52 65 61 70 0a 0a 20 20 20 20 6d hreadReap.. m
cf80: 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 20 09 70 akeFile {. .p
cf90: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
cfa0: 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a ls..set f [tls::
cfb0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
cfc0: 63 63 65 70 74 20 38 38 32 38 5d 0a 09 70 72 6f ccept 8828]..pro
cfd0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
cfe0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 {. f
cff0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
d000: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
d010: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
d020: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
d030: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
d040: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
d050: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 ho {s} {.. g
d060: 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 lobal i.
d070: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
d080: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
d090: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
d0a0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
d0b0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
d0c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
d0d0: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
d0e0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
d0f0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
d100: 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 else { ..
d110: 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 incr i.
d120: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
d130: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
d140: 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 }..}..set i 0
d150: 0a 09 76 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 ..vwait x..close
d160: 20 24 66 0a 0a 09 23 20 74 68 72 65 61 64 20 63 $f...# thread c
d170: 6c 65 61 6e 73 20 69 74 73 65 6c 66 20 75 70 2e leans itself up.
d180: 0a 09 74 65 73 74 74 68 72 65 61 64 20 65 78 69 ..testthread exi
d190: 74 0a 20 20 20 20 7d 20 73 63 72 69 70 74 0a 20 t. } script.
d1a0: 20 20 20 0a 20 20 20 20 23 20 63 72 65 61 74 65 . # create
d1b0: 20 61 20 74 68 72 65 61 64 0a 20 20 20 20 73 65 a thread. se
d1c0: 74 20 73 65 72 76 65 72 74 68 72 65 61 64 20 5b t serverthread [
d1d0: 74 65 73 74 74 68 72 65 61 64 20 63 72 65 61 74 testthread creat
d1e0: 65 20 7b 20 73 6f 75 72 63 65 20 73 63 72 69 70 e { source scrip
d1f0: 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 61 74 65 t } ]. update
d200: 0a 20 20 20 20 0a 20 20 20 20 61 66 74 65 72 20 . . after
d210: 31 30 30 30 0a 20 20 20 20 73 65 74 20 73 20 5b 1000. set s [
d220: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
d230: 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 0.0.1 8828].
d240: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
d250: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 uffering line..
d260: 20 20 20 63 61 74 63 68 20 7b 0a 09 70 75 74 73 catch {..puts
d270: 20 24 73 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 $s "hello"..get
d280: 73 20 24 73 20 72 65 73 75 6c 74 0a 20 20 20 20 s $s result.
d290: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 }. close $s.
d2a0: 20 20 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 update.. a
d2b0: 66 74 65 72 20 32 30 30 30 0a 20 20 20 20 6c 61 fter 2000. la
d2c0: 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 ppend result [th
d2d0: 72 65 61 64 52 65 61 70 5d 0a 20 20 20 20 0a 20 readReap]. .
d2e0: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d set result..}
d2f0: 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c {hello 1}..# cl
d300: 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e eanup.if {[strin
d310: 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 g match sock* $c
d320: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d ommandSocket] ==
d330: 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 63 1} {. puts $c
d340: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 ommandSocket exi
d350: 74 0a 20 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d t. flush $comm
d360: 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 andSocket.}.catc
d370: 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e h {close $comman
d380: 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b dSocket}.catch {
d390: 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 6f close $remotePro
d3a0: 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 cChan}.::tcltest
d3b0: 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 ::cleanupTests.f
d3c0: 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 65 74 75 lush stdout.retu
d3d0: 72 6e 0a 0a rn..