0000: 23 20 43 6f 6d 6d 61 6e 64 73 20 74 65 73 74 65 # Commands teste
0010: 64 20 69 6e 20 74 68 69 73 20 66 69 6c 65 3a 20 d in this file:
0020: 73 6f 63 6b 65 74 2e 0a 23 0a 23 20 54 68 69 73 socket..#.# This
0030: 20 66 69 6c 65 20 63 6f 6e 74 61 69 6e 73 20 61 file contains a
0040: 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 6f 66 20 74 collection of t
0050: 65 73 74 73 20 66 6f 72 20 6f 6e 65 20 6f 72 20 ests for one or
0060: 6d 6f 72 65 20 6f 66 20 74 68 65 20 54 63 6c 0a more of the Tcl.
0070: 23 20 62 75 69 6c 74 2d 69 6e 20 63 6f 6d 6d 61 # built-in comma
0080: 6e 64 73 2e 20 20 53 6f 75 72 63 69 6e 67 20 74 nds. Sourcing t
0090: 68 69 73 20 66 69 6c 65 20 69 6e 74 6f 20 54 63 his file into Tc
00a0: 6c 20 72 75 6e 73 20 74 68 65 20 74 65 73 74 73 l runs the tests
00b0: 20 61 6e 64 0a 23 20 67 65 6e 65 72 61 74 65 73 and.# generates
00c0: 20 6f 75 74 70 75 74 20 66 6f 72 20 65 72 72 6f output for erro
00d0: 72 73 2e 20 20 4e 6f 20 6f 75 74 70 75 74 20 6d rs. No output m
00e0: 65 61 6e 73 20 6e 6f 20 65 72 72 6f 72 73 20 77 eans no errors w
00f0: 65 72 65 20 66 6f 75 6e 64 2e 0a 23 0a 23 20 43 ere found..#.# C
0100: 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 39 opyright (c) 199
0110: 34 2d 31 39 39 36 20 53 75 6e 20 4d 69 63 72 6f 4-1996 Sun Micro
0120: 73 79 73 74 65 6d 73 2c 20 49 6e 63 2e 0a 23 20 systems, Inc..#
0130: 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 Copyright (c) 19
0140: 39 38 2d 32 30 30 30 20 41 6a 75 62 61 20 53 6f 98-2000 Ajuba So
0150: 6c 75 74 69 6f 6e 73 2e 20 0a 23 0a 23 20 53 65 lutions. .#.# Se
0160: 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 63 65 e the file "lice
0170: 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 20 69 nse.terms" for i
0180: 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73 nformation on us
0190: 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 72 69 age and redistri
01a0: 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 69 73 bution.# of this
01b0: 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20 61 file, and for a
01c0: 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20 41 DISCLAIMER OF A
01d0: 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0a 23 LL WARRANTIES..#
01e0: 0a 23 20 52 43 53 3a 20 40 28 23 29 20 24 49 64 .# RCS: @(#) $Id
01f0: 3a 20 74 6c 73 49 4f 2e 74 65 73 74 2c 76 20 31 : tlsIO.test,v 1
0200: 2e 31 34 20 32 30 30 30 2f 30 36 2f 30 38 20 30 .14 2000/06/08 0
0210: 30 3a 30 36 3a 34 30 20 61 62 6f 72 72 20 45 78 0:06:40 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 38 38 32 38 20 5c 5d 22 0a verKey 8828 \]".
25c0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
25d0: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
25e0: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 addr port} {..
25f0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
2600: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
2610: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
2620: 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 ile..}..puts rea
2630: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
2640: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
2650: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
2660: 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $x. }. cl
2670: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
2680: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
2690: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
26a0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
26b0: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
26c0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
26d0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
26e0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
26f0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
2700: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
2710: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
2720: 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 8828} msg]} {.
2730: 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 set x $msg
2740: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
2750: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
2760: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
2770: 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 close $msg.
2780: 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 }. lappend x
2790: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
27a0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
27b0: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 x.} {ready done
27c0: 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 78 {}}..if [info ex
27d0: 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 20 ists port] {.
27e0: 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c 73 incr port.} els
27f0: 65 20 7b 20 0a 20 20 20 20 73 65 74 20 70 6f 72 e { . set por
2800: 74 20 5b 65 78 70 72 20 24 74 6c 73 53 65 72 76 t [expr $tlsServ
2810: 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 erPort + [pid]%1
2820: 30 32 34 5d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 024].}..test tls
2830: 49 4f 2d 32 2e 32 20 7b 74 63 70 20 63 6f 6e 6e IO-2.2 {tcp conn
2840: 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 ection with clie
2850: 6e 74 20 70 6f 72 74 20 73 70 65 63 69 66 69 65 nt port specifie
2860: 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f d} {socket stdio
2870: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
2880: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
2890: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
28a0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
28b0: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
28c0: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
28d0: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
28e0: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
28f0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
2900: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
2910: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
2920: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
2930: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
2940: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
2950: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 39 $serverKey 8829
2960: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
2970: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
2980: 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d {file addr port}
2990: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 {. g
29a0: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
29b0: 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 puts "[gets
29c0: 24 66 69 6c 65 5d 20 24 70 6f 72 74 22 0a 20 20 $file] $port".
29d0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
29e0: 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 $file.
29f0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a set x done..}.
2a00: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
2a10: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
2a20: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
2a30: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
2a40: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
2a50: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
2a60: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
2a70: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
2a80: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
2a90: 20 67 6c 6f 62 61 6c 20 70 6f 72 74 0a 20 20 20 global port.
2aa0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
2ab0: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 ::socket -myport
2ac0: 20 24 70 6f 72 74 20 5c 0a 09 2d 63 65 72 74 66 $port \..-certf
2ad0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
2ae0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2af0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
2b00: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
2b10: 20 38 38 32 39 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 8829} sock]} {.
2b20: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 set x $s
2b30: 6f 63 6b 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 ock..catch {clos
2b40: 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 e [tls::socket 1
2b50: 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 7d 0a 27.0.0.1 8829]}.
2b60: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
2b70: 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 puts $sock
2b80: 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f hello..flush $so
2b90: 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 ck. lappe
2ba0: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
2bb0: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f close $so
2bc0: 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f ck. }. clo
2bd0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
2be0: 7d 20 5b 6c 69 73 74 20 72 65 61 64 79 20 22 68 } [list ready "h
2bf0: 65 6c 6c 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 65 ello $port"]..te
2c00: 73 74 20 74 6c 73 49 4f 2d 32 2e 33 20 7b 74 63 st tlsIO-2.3 {tc
2c10: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 p connection wit
2c20: 68 20 63 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 h client interfa
2c30: 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 ce specified} {s
2c40: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
2c50: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
2c60: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
2c70: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
2c80: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
2c90: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
2ca0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
2cb0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
2cc0: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
2cd0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2ce0: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2cf0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
2d00: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
2d10: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2d20: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
2d30: 76 65 72 4b 65 79 20 38 38 33 30 20 5c 5d 22 0a verKey 8830 \]".
2d40: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
2d50: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
2d60: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
2d70: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
2d80: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
2d90: 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 uts "[gets $file
2da0: 5d 20 24 61 64 64 72 22 0a 20 20 20 20 20 20 20 ] $addr".
2db0: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 close $file
2dc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
2dd0: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
2de0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
2df0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
2e00: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
2e10: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2e20: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2e30: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2e40: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2e50: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2e60: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
2e70: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2e80: 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 32 37 2e ket -myaddr 127.
2e90: 30 2e 30 2e 31 20 5c 0a 09 2d 63 65 72 74 66 69 0.0.1 \..-certfi
2ea0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
2eb0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
2ec0: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
2ed0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
2ee0: 38 38 33 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 8830} sock]} {.
2ef0: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f set x $so
2f00: 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ck. } else {.
2f10: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
2f20: 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 74 63 68 20 ck hello..catch
2f30: 7b 66 6c 75 73 68 20 24 73 6f 63 6b 7d 0a 20 20 {flush $sock}.
2f40: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
2f50: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
2f60: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
2f70: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
2f80: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
2f90: 61 64 79 20 7b 68 65 6c 6c 6f 20 31 32 37 2e 30 ady {hello 127.0
2fa0: 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 .0.1}}..test tls
2fb0: 49 4f 2d 32 2e 34 20 7b 74 63 70 20 63 6f 6e 6e IO-2.4 {tcp conn
2fc0: 65 63 74 69 6f 6e 20 77 69 74 68 20 73 65 72 76 ection with serv
2fd0: 65 72 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 er interface spe
2fe0: 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 cified} {socket
2ff0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
3000: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
3010: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3020: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3030: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
3040: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
3050: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
3060: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
3070: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
3080: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
3090: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
30a0: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
30b0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
30c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
30d0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
30e0: 20 2d 6d 79 61 64 64 72 20 5b 69 6e 66 6f 20 68 -myaddr [info h
30f0: 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 20 5c 5d ostname] 8831 \]
3100: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
3110: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
3120: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
3130: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
3140: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
3150: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 puts "[gets $fi
3160: 6c 65 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 le]".
3170: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 close $file.
3180: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
3190: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
31a0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
31b0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
31c0: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
31d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
31e0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
31f0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3200: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3210: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
3220: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
3230: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
3240: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
3250: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
3260: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
3270: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e e $clientKey [in
3280: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 fo hostname] 883
3290: 31 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 1} sock]} {.
32a0: 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a set x $sock.
32b0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
32c0: 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 puts $sock
32d0: 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f hello..flush $so
32e0: 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 ck. lappe
32f0: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
3300: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f close $so
3310: 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f ck. }. clo
3320: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
3330: 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a } {ready hello}.
3340: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 35 20 .test tlsIO-2.5
3350: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 {tcp connection
3360: 77 69 74 68 20 72 65 64 75 6e 64 61 6e 74 20 73 with redundant s
3370: 65 72 76 65 72 20 70 6f 72 74 7d 20 7b 73 6f 63 erver port} {soc
3380: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3390: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
33a0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
33b0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
33c0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
33d0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
33e0: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
33f0: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f r 2000 "set x do
3400: 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ne"]. }. p
3410: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3420: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3430: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
3440: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
3450: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3460: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
3470: 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 0a 20 20 rKey 8832 \]".
3480: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
3490: 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 c accept {file a
34a0: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 ddr port} {.
34b0: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
34c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
34d0: 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 s "[gets $file]"
34e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
34f0: 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 se $file.
3500: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
3510: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
3520: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
3530: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
3540: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
3550: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
3560: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
3570: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
3580: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
3590: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
35a0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
35b0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
35c0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
35d0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
35e0: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
35f0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
3600: 2e 31 20 38 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 .1 8832} sock]}
3610: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
3620: 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 $sock. } else
3630: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
3640: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
3650: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
3660: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
3670: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
3680: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3690: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
36a0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 set x.} {ready h
36b0: 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 6c 73 49 4f ello}.test tlsIO
36c0: 2d 32 2e 36 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.6 {tcp connec
36d0: 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b tion} {socket} {
36e0: 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 . set status
36f0: 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 ok. if {![cat
3700: 63 68 20 7b 73 65 74 20 73 6f 63 6b 20 5b 74 6c ch {set sock [tl
3710: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
3720: 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 20 7b 0a 09 0.1 8833]}]} {..
3730: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 if {![catch {get
3740: 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 s $sock}]} {..
3750: 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f set status bro
3760: 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 ken..}..close $s
3770: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ock. }. se
3780: 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 t status.} ok..t
3790: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 37 20 7b 65 est tlsIO-2.7 {e
37a0: 63 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 cho server, one
37b0: 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 line} {socket st
37c0: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
37d0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
37e0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
37f0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
3800: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
3810: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
3820: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
3830: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 "set x done"].
3840: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
3850: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
3860: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
3870: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
3880: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
3890: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
38a0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
38b0: 38 33 34 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 834 \]". puts
38c0: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
38d0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 pt {s a p} {.
38e0: 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 fileeve
38f0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
3900: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 list echo $s]..
3910: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
3920: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
3930: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
3940: 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 . }..proc
3950: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
3960: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
3970: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
3980: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
3990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39a0: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
39b0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
39c0: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
39d0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
39e0: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
39f0: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 se {.
3a00: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
3a10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a . }.
3a20: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
3a30: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
3a40: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
3a50: 6f 73 65 20 24 66 0a 09 70 75 74 73 20 64 6f 6e ose $f..puts don
3a60: 65 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 e. }. clos
3a70: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3a80: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3a90: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3aa0: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3ab0: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
3ac0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
3ad0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
3ae0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
3af0: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
3b00: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
3b10: 2e 30 2e 30 2e 31 20 38 38 33 34 5d 0a 20 20 20 .0.0.1 8834].
3b20: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
3b30: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
3b40: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 translation lf.
3b50: 20 20 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c puts $s "hell
3b60: 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e o abcdefghijklmn
3b70: 6f 70 22 0a 20 20 20 20 61 66 74 65 72 20 31 30 op". after 10
3b80: 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 00. set x [ge
3b90: 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $s]. close
3ba0: 20 24 73 0a 20 20 20 20 73 65 74 20 79 20 5b 67 $s. set y [g
3bb0: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
3bc0: 65 20 24 66 0a 20 20 20 20 6c 69 73 74 20 24 78 e $f. list $x
3bd0: 20 24 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 $y.} {{hello ab
3be0: 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 cdefghijklmnop}
3bf0: 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 done}..test tlsI
3c00: 4f 2d 32 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 O-2.8 {echo serv
3c10: 65 72 2c 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 er, loop 50 time
3c20: 73 2c 20 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 s, single connec
3c30: 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 tion} {socket st
3c40: 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 dio} {. set f
3c50: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
3c60: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 . puts $f {.
3c70: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
3c80: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
3c90: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
3ca0: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
3cb0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
3cc0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
3cd0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
3ce0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
3cf0: 72 76 65 72 4b 65 79 20 38 38 33 35 20 5c 5d 22 rverKey 8835 \]"
3d00: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
3d10: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
3d20: 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 p} {.
3d30: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
3d40: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
3d50: 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ho $s].
3d60: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
3d70: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
3d80: 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 . }..proc
3d90: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
3da0: 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 global i.
3db0: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
3dc0: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
3dd0: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
3de0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
3df0: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
3e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e10: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
3e20: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
3e30: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
3e40: 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 } else { ..
3e50: 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 incr i.
3e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
3e70: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
3e80: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 }..}..set
3e90: 69 20 30 0a 09 70 75 74 73 20 72 65 61 64 79 0a i 0..puts ready.
3ea0: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
3eb0: 72 20 32 30 30 30 30 20 22 73 65 74 20 78 20 64 r 20000 "set x d
3ec0: 6f 6e 65 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 one"]..vwait x..
3ed0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
3ee0: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 mer..close $f..p
3ef0: 75 74 73 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 uts "done $i".
3f00: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
3f10: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
3f20: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
3f30: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
3f40: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
3f50: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
3f60: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
3f70: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
3f80: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3f90: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
3fa0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
3fb0: 2e 31 20 38 38 33 35 5d 0a 20 20 20 20 66 63 6f .1 8835]. fco
3fc0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
3fd0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 ering line. c
3fe0: 61 74 63 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 atch {..for {set
3ff0: 20 78 20 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 x 0} {$x < 50}
4000: 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 {incr x} {..
4010: 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 puts $s "hello a
4020: 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 bcdefghijklmnop"
4030: 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d .. gets $s..}
4040: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
4050: 20 24 73 0a 20 20 20 20 63 61 74 63 68 20 7b 73 $s. catch {s
4060: 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a et x [gets $f]}.
4070: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
4080: 20 73 65 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 set x.} {done 5
4090: 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 0}..test tlsIO-2
40a0: 2e 39 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c .9 {socket confl
40b0: 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ict} {socket std
40c0: 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 io} {. set s
40d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
40e0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 rver accept 8828
40f0: 5d 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 ]. removeFile
4100: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
4110: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
4120: 5d 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 ]. puts -none
4130: 77 6c 69 6e 65 20 24 66 20 7b 70 61 63 6b 61 67 wline $f {packag
4140: 65 20 72 65 71 75 69 72 65 20 74 6c 73 3b 20 74 e require tls; t
4150: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4160: 65 72 20 61 63 63 65 70 74 20 38 38 32 38 7d 0a er accept 8828}.
4170: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
4180: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
4190: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
41a0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
41b0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
41c0: 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 . after 100.
41d0: 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b set x [list [
41e0: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d catch {close $f}
41f0: 20 6d 73 67 5d 20 24 6d 73 67 5d 0a 20 20 20 20 msg] $msg].
4200: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 close $s. set
4210: 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 x.} {1 {couldn'
4220: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 t open socket: a
4230: 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 ddress already i
4240: 6e 20 75 73 65 0a 20 20 20 20 77 68 69 6c 65 20 n use. while
4250: 65 78 65 63 75 74 69 6e 67 0a 22 3a 3a 73 6f 63 executing."::soc
4260: 6b 65 74 20 2d 73 65 72 76 65 72 20 7b 74 6c 73 ket -server {tls
4270: 3a 3a 5f 61 63 63 65 70 74 20 7b 2d 73 65 72 76 ::_accept {-serv
4280: 65 72 20 31 7d 20 61 63 63 65 70 74 7d 20 38 38 er 1} accept} 88
4290: 32 38 22 0a 20 20 20 20 28 22 65 76 61 6c 22 20 28". ("eval"
42a0: 62 6f 64 79 20 6c 69 6e 65 20 31 29 0a 20 20 20 body line 1).
42b0: 20 69 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 invoked from wi
42c0: 74 68 69 6e 0a 22 65 76 61 6c 20 3a 3a 73 6f 63 thin."eval ::soc
42d0: 6b 65 74 20 24 73 6f 70 74 73 22 0a 20 20 20 20 ket $sopts".
42e0: 28 70 72 6f 63 65 64 75 72 65 20 22 74 6c 73 3a (procedure "tls:
42f0: 3a 73 6f 63 6b 65 74 22 20 6c 69 6e 65 20 36 32 :socket" line 62
4300: 29 0a 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 ). invoked fr
4310: 6f 6d 20 77 69 74 68 69 6e 0a 22 74 6c 73 3a 3a om within."tls::
4320: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4330: 63 63 65 70 74 20 38 38 32 38 22 0a 20 20 20 20 ccept 8828".
4340: 28 66 69 6c 65 20 22 73 63 72 69 70 74 22 20 6c (file "script" l
4350: 69 6e 65 20 31 29 7d 7d 0a 0a 74 65 73 74 20 74 ine 1)}}..test t
4360: 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 lsIO-2.10 {close
4370: 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 on accept, acce
4380: 70 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 pted socket live
4390: 73 7d 20 7b 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e s} {socket known
43a0: 42 75 67 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 Bug} {. set d
43b0: 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 one 0. set ti
43c0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 mer [after 20000
43d0: 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 "set done timed
43e0: 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 _out"]. set s
43f0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
4400: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
4410: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
4420: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4430: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4440: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 30 5d $serverKey 8830]
4450: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
4460: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 {s a p} {..glob
4470: 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24 73 73 al ss..close $ss
4480: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
4490: 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 eadable "readit
44a0: 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 $s"..fconfigure
44b0: 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20 20 20 $s -trans lf.
44c0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 }. proc read
44d0: 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c it {s} {..global
44e0: 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 73 0a 09 done..gets $s..
44f0: 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 64 6f close $s..set do
4500: 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 73 ne 1. }. s
4510: 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b et cs [tls::sock
4520: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
4530: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
4540: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
4550: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
4560: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
4570: 38 38 33 30 5d 0a 20 20 20 20 63 6c 6f 73 65 20 8830]. close
4580: 24 63 73 0a 0a 20 20 20 20 76 77 61 69 74 20 64 $cs.. vwait d
4590: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
45a0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
45b0: 73 65 74 20 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 set done.} 1..te
45c0: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 st tlsIO-2.11 {d
45d0: 65 74 65 63 74 69 6e 67 20 6e 65 77 20 64 61 74 etecting new dat
45e0: 61 7d 20 7b 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e a} {socket known
45f0: 42 75 67 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 Bug} {. proc
4600: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
4610: 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 73 ..global sock..s
4620: 65 74 20 73 6f 63 6b 20 24 73 0a 09 73 65 74 20 et sock $s..set
4630: 66 20 5b 6f 70 65 6e 20 61 77 62 2e 6c 6f 67 20 f [open awb.log
4640: 77 5d 0a 09 70 75 74 73 20 24 66 20 5b 63 61 74 w]..puts $f [cat
4650: 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 ch {tls::handsha
4660: 6b 65 20 24 73 6f 63 6b 7d 20 65 72 72 5d 0a 09 ke $sock} err]..
4670: 70 75 74 73 20 24 66 20 22 65 72 72 3a 20 24 65 puts $f "err: $e
4680: 72 72 22 0a 09 70 75 74 73 20 24 66 20 22 5b 74 rr"..puts $f "[t
4690: 6c 73 3a 3a 73 74 61 74 75 73 20 24 73 6f 63 6b ls::status $sock
46a0: 5d 22 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 ]"..close $s.
46b0: 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }.. set s [t
46c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 ls::socket -requ
46d0: 69 72 65 20 30 20 2d 72 65 71 75 65 73 74 20 30 ire 0 -request 0
46e0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
46f0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
4700: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
4710: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
4720: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 34 30 e $serverKey 840
4730: 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 20 0]. set sock
4740: 22 22 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 "". set s2 [t
4750: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
4760: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
4770: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4780: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
4790: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
47a0: 31 20 38 34 30 30 5d 0a 20 20 20 20 76 77 61 69 1 8400]. vwai
47b0: 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 t sock. puts
47c0: 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 6c 75 73 $s2 one. flus
47d0: 68 20 24 73 32 0a 20 20 20 20 61 66 74 65 72 20 h $s2. after
47e0: 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 500. fconfigu
47f0: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
4800: 6e 67 20 30 0a 20 20 20 20 73 65 74 20 72 65 73 ng 0. set res
4810: 75 6c 74 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d ult [gets $sock]
4820: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 . lappend res
4830: 75 6c 74 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d ult [gets $sock]
4840: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4850: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
4860: 31 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 74 1. puts $s2 t
4870: 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 wo. flush $s2
4880: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4890: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
48a0: 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 0. lappend re
48b0: 73 75 6c 74 20 5b 67 65 74 73 20 24 73 6f 63 6b sult [gets $sock
48c0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
48d0: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
48e0: 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 1. close $s2
48f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
4900: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
4910: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 7b set result.} {
4920: 6f 6e 65 20 7b 7d 20 74 77 6f 7d 0a 0a 74 65 73 one {} two}..tes
4930: 74 20 74 6c 73 49 4f 2d 32 2e 31 32 20 7b 74 63 t tlsIO-2.12 {tc
4940: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f p connection; no
4950: 20 63 65 72 74 69 66 69 63 61 74 65 73 20 73 70 certificates sp
4960: 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 ecified} {socket
4970: 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 stdio pcCrash}
4980: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
4990: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
49a0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
49b0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
49c0: 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 .package req
49d0: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
49e0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
49f0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
4a00: 22 5d 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a "]..set f [tls::
4a10: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4a20: 63 63 65 70 74 20 38 38 32 38 5d 0a 09 70 72 6f ccept 8828]..pro
4a30: 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 c accept {file a
4a40: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 ddr port} {..
4a50: 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 global x.. s
4a60: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
4a70: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c close $fil
4a80: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
4a90: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
4aa0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
4ab0: 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 close $f..puts $
4ac0: 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 x. }. clos
4ad0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
4ae0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
4af0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
4b00: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
4b10: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
4b20: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
4b30: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
4b40: 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 8828} msg]} {.
4b50: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 set x $ms
4b60: 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 g. } else {.
4b70: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
4b80: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
4b90: 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 close $msg.
4ba0: 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 }. lappend
4bb0: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
4bc0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
4bd0: 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 x.} {ready done
4be0: 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f {}}..test tlsIO
4bf0: 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e -3.1 {socket con
4c00: 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 flict} {socket s
4c10: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
4c20: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
4c30: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
4c40: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
4c50: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
4c60: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
4c70: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
4c80: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
4c90: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4ca0: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
4cb0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
4cc0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
4cd0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
4ce0: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 828 \]". puts
4cf0: 20 24 66 20 7b 0a 09 70 75 74 73 20 72 65 61 64 $f {..puts read
4d00: 79 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 63 y..gets stdin..c
4d10: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
4d20: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
4d30: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
4d40: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
4d50: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
4d60: 72 2b 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r+]. gets $f.
4d70: 20 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 set x [list
4d80: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
4d90: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
4da0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
4db0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4dc0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
4dd0: 74 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 tKey \. .-ser
4de0: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 7d ver accept 8828}
4df0: 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a msg] \...$msg].
4e00: 20 20 20 20 70 75 74 73 20 24 66 20 62 79 65 0a puts $f bye.
4e10: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
4e20: 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 set x.} {1 {cou
4e30: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
4e40: 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 t: address alrea
4e50: 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 dy in use}}..tes
4e60: 74 20 74 6c 73 49 4f 2d 33 2e 32 20 7b 73 65 72 t tlsIO-3.2 {ser
4e70: 76 65 72 20 77 69 74 68 20 73 65 76 65 72 61 6c ver with several
4e80: 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 clients} {socke
4e90: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
4ea0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
4eb0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4ec0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
4ed0: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
4ee0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
4ef0: 73 0a 09 73 65 74 20 74 31 20 5b 61 66 74 65 72 s..set t1 [after
4f00: 20 33 30 30 30 30 20 22 73 65 74 20 78 20 74 69 30000 "set x ti
4f10: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 med_out"]..set t
4f20: 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 2 [after 31000 "
4f30: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
4f40: 5d 0a 09 73 65 74 20 74 33 20 5b 61 66 74 65 72 ]..set t3 [after
4f50: 20 33 32 30 30 30 20 22 73 65 74 20 78 20 74 69 32000 "set x ti
4f60: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 63 med_out"]..set c
4f70: 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 7d 0a 20 ounter 0. }.
4f80: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
4f90: 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s \[tls::socket
4fa0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
4fb0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
4fc0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4fd0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
4fe0: 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d erverKey 8828 \]
4ff0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
5000: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
5010: 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 a p} {.. file
5020: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
5030: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
5040: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
5050: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
5060: 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 ine..}..proc ech
5070: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c o {s} {.. gl
5080: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
5090: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
50a0: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
50b0: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
50c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
50d0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
50e0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
50f0: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
5100: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
5110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
5120: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
5130: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 }..}..puts
5140: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
5150: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
5160: 31 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 1..vwait x..afte
5170: 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 r cancel $t2..vw
5180: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
5190: 63 65 6c 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 cel $t3..close $
51a0: 73 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d s..puts $x. }
51b0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
51c0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
51d0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
51e0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
51f0: 5d 22 20 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 ]" r+]. set x
5200: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 73 [gets $f]. s
5210: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
5220: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
5230: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
5240: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
5250: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
5260: 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 Key \.. 127.0
5270: 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 .0.1 8828]. f
5280: 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 configure $s1 -b
5290: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
52a0: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
52b0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
52c0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
52d0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
52e0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
52f0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
5300: 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 7.0.0.1 8828].
5310: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 fconfigure $s2
5320: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5330: 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 . set s3 [tls
5340: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
5350: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
5360: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
5370: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5380: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
5390: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 127.0.0.1 8828]
53a0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
53b0: 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s3 -buffering l
53c0: 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 ine. for {set
53d0: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d i 0} {$i < 100}
53e0: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 {incr i} {..put
53f0: 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 s $s1 hello,s1..
5400: 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 gets $s1..puts $
5410: 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 s2 hello,s2..get
5420: 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 s $s2..puts $s3
5430: 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 hello,s3..gets $
5440: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f s3. }. clo
5450: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 se $s1. close
5460: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
5470: 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 s3. lappend x
5480: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
5490: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
54a0: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d x.} {ready done}
54b0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e 31 ..test tlsIO-4.1
54c0: 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 {server with se
54d0: 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b veral clients} {
54e0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
54f0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
5500: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
5510: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
5520: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
5530: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
5540: 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 re tls..gets std
5550: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 in. }. put
5560: 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b 74 6c s $f "set s \[tl
5570: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
5580: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
5590: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
55a0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
55b0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
55c0: 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 28 \]". puts
55d0: 24 66 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 $f {..fconfigure
55e0: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
55f0: 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 ine..for {set i
5600: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
5610: 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 70 75 ncr i} {.. pu
5620: 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 20 20 20 ts $s hello..
5630: 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 63 6c 6f gets $s..}..clo
5640: 73 65 20 24 73 0a 09 70 75 74 73 20 62 79 65 0a se $s..puts bye.
5650: 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 .gets stdin.
5660: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
5670: 20 20 20 73 65 74 20 70 31 20 5b 6f 70 65 6e 20 set p1 [open
5680: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
5690: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
56a0: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f pt]" r+]. fco
56b0: 6e 66 69 67 75 72 65 20 24 70 31 20 2d 62 75 66 nfigure $p1 -buf
56c0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
56d0: 73 65 74 20 70 32 20 5b 6f 70 65 6e 20 22 7c 5b set p2 [open "|[
56e0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
56f0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5700: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
5710: 67 75 72 65 20 24 70 32 20 2d 62 75 66 66 65 72 gure $p2 -buffer
5720: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
5730: 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 p3 [open "|[lis
5740: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
5750: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
5760: 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 +]. fconfigur
5770: 65 20 24 70 33 20 2d 62 75 66 66 65 72 69 6e 67 e $p3 -buffering
5780: 20 6c 69 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 line. proc a
5790: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
57a0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
57b0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
57c0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
57d0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
57e0: 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 $s]. }. p
57f0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
5800: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
5810: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
5820: 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f . if {[eo
5830: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
5840: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
5850: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
5860: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 7d 20 65 done. } e
5870: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 lse {.
5880: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
5890: 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 }. }.
58a0: 20 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 set t1 [after 3
58b0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
58c0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 d_out"]. set
58d0: 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 t2 [after 31000
58e0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
58f0: 22 5d 0a 20 20 20 20 73 65 74 20 74 33 20 5b 61 "]. set t3 [a
5900: 66 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 fter 32000 "set
5910: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
5920: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
5930: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
5940: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
5950: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5960: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
5970: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
5980: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 rver accept 8828
5990: 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 6f ]. puts $p1 o
59a0: 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 32 pen. puts $p2
59b0: 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 open. puts $
59c0: 70 33 20 6f 70 65 6e 0a 20 20 20 20 76 77 61 69 p3 open. vwai
59d0: 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a t x. vwait x.
59e0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
59f0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 after cancel $t1
5a00: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
5a10: 6c 20 24 74 32 0a 20 20 20 20 61 66 74 65 72 20 l $t2. after
5a20: 63 61 6e 63 65 6c 20 24 74 33 0a 20 20 20 20 63 cancel $t3. c
5a30: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
5a40: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
5a50: 20 6c 20 5b 6c 69 73 74 20 70 31 20 5b 67 65 74 l [list p1 [get
5a60: 73 20 24 70 31 5d 20 24 78 5d 0a 20 20 20 20 6c s $p1] $x]. l
5a70: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 append l [list p
5a80: 32 20 5b 67 65 74 73 20 24 70 32 5d 20 24 78 5d 2 [gets $p2] $x]
5a90: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
5aa0: 6c 69 73 74 20 70 33 20 5b 67 65 74 73 20 24 70 list p3 [gets $p
5ab0: 33 5d 20 24 78 5d 0a 20 20 20 20 70 75 74 73 20 3] $x]. puts
5ac0: 24 70 31 20 62 79 65 0a 20 20 20 20 70 75 74 73 $p1 bye. puts
5ad0: 20 24 70 32 20 62 79 65 0a 20 20 20 20 70 75 74 $p2 bye. put
5ae0: 73 20 24 70 33 20 62 79 65 0a 20 20 20 20 63 6c s $p3 bye. cl
5af0: 6f 73 65 20 24 70 31 0a 20 20 20 20 63 6c 6f 73 ose $p1. clos
5b00: 65 20 24 70 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $p2. close
5b10: 24 70 33 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 $p3. set l.}
5b20: 7b 7b 70 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b {{p1 bye done} {
5b30: 70 32 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 p2 bye done} {p3
5b40: 20 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 bye done}}..tes
5b50: 74 20 74 6c 73 49 4f 2d 34 2e 32 20 7b 62 79 74 t tlsIO-4.2 {byt
5b60: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
5b70: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
5b80: 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 , htons} {socket
5b90: 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 6f 6b } {. set x ok
5ba0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
5bb0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
5bc0: 72 76 65 72 20 64 6f 64 6f 20 30 78 33 30 30 30 rver dodo 0x3000
5bd0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
5be0: 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 $msg. } else
5bf0: 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 {..close $msg.
5c00: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
5c10: 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ok..test tlsIO-
5c20: 35 2e 31 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.1 {byte order
5c30: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
5c40: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
5c50: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 \..{socket unix
5c60: 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a Only notRoot} {.
5c70: 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 set x {could
5c80: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
5c90: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 not owner}.
5ca0: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 if {![catch {tls
5cb0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
5cc0: 20 64 6f 64 6f 20 30 78 31 7d 20 6d 73 67 5d 7d dodo 0x1} msg]}
5cd0: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
5ce0: 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c {htons problem,
5cf0: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
5d00: 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 lowed, are you r
5d10: 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 unning as SU?}..
5d20: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
5d30: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f . set x.} {co
5d40: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5d50: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 74 et: not owner}.t
5d60: 65 73 74 20 74 6c 73 49 4f 2d 35 2e 32 20 7b 62 est tlsIO-5.2 {b
5d70: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
5d80: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
5d90: 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b rs, htons} {sock
5da0: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 et} {. set x
5db0: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
5dc0: 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 ocket: port numb
5dd0: 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 20 20 20 er too high}.
5de0: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c if {![catch {tl
5df0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5e00: 72 20 64 6f 64 6f 20 30 78 31 30 30 30 30 7d 20 r dodo 0x10000}
5e10: 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b msg]} {..set x {
5e20: 70 6f 72 74 20 72 65 73 6f 6c 75 74 69 6f 6e 20 port resolution
5e30: 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 problem, should
5e40: 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 7d 0a 09 be disallowed}..
5e50: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
5e60: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f . set x.} {co
5e70: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5e80: 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 et: port number
5e90: 74 6f 6f 20 68 69 67 68 7d 0a 74 65 73 74 20 74 too high}.test t
5ea0: 6c 73 49 4f 2d 35 2e 33 20 7b 62 79 74 65 20 6f lsIO-5.3 {byte o
5eb0: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
5ec0: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
5ed0: 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 tons} \..{socket
5ee0: 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f unixOnly notRoo
5ef0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b t} {. set x {
5f00: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
5f10: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
5f20: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
5f30: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
5f40: 65 72 76 65 72 20 64 6f 64 6f 20 32 31 7d 20 6d erver dodo 21} m
5f50: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 sg]} {..set x {h
5f60: 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 tons problem, sh
5f70: 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 ould be disallow
5f80: 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e ed, are you runn
5f90: 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f ing as SU?}..clo
5fa0: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
5fb0: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 set x.} {could
5fc0: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
5fd0: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 not owner}..tes
5fe0: 74 20 74 6c 73 49 4f 2d 36 2e 31 20 7b 61 63 63 t tlsIO-6.1 {acc
5ff0: 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 ept callback err
6000: 6f 72 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 or} {unexplained
6010: 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 73 Failure socket s
6020: 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a tdio pcCrash} {.
6030: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
6040: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
6050: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
6060: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
6070: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
6080: 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 re tls..gets std
6090: 69 6e 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 in..tls::socket
60a0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 34 38 0a 20 127.0.0.1 8848.
60b0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
60c0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
60d0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
60e0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
60f0: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 70 ript]" r+]. p
6100: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 roc bgerror args
6110: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
6120: 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d 0a t x $args. }.
6130: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
6140: 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 {s a p} {expr 10
6150: 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 20 73 20 / 0}. set s
6160: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
6170: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 34 38 rver accept 8848
6180: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 65 ]. puts $f he
6190: 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 llo. close $f
61a0: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
61b0: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
61c0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
61d0: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 vwait x. a
61e0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
61f0: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a er. close $s.
6200: 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 rename bgerr
6210: 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a or {}. set x.
6220: 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 } {{divide by ze
6230: 72 6f 7d 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f ro}}..# bug repo
6240: 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 rt #5812 fconfig
6250: 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 ure doesn't retu
6260: 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 70 rn value for '-p
6270: 65 65 72 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 eername'..test t
6280: 6c 73 49 4f 2d 37 2e 31 20 7b 74 65 73 74 69 6e lsIO-7.1 {testin
6290: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
62a0: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 c options} {know
62b0: 6e 42 75 67 20 73 6f 63 6b 65 74 20 73 74 64 69 nBug socket stdi
62c0: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
62d0: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
62e0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
62f0: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
6300: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
6310: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
6320: 20 20 70 75 74 73 20 24 66 20 22 74 6c 73 3a 3a puts $f "tls::
6330: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6340: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
6350: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
6360: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
6370: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
6380: 38 38 32 30 22 0a 20 20 20 20 70 75 74 73 20 24 8820". puts $
6390: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
63a0: 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f args {.. glo
63b0: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
63c0: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
63d0: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
63e0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
63f0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
6400: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
6410: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6420: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
6430: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
6440: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
6450: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
6460: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
6470: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
6480: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
6490: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
64a0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
64b0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
64c0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
64d0: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
64e0: 32 30 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 20]. set p [f
64f0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 configure $s -pe
6500: 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ername]. clos
6510: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
6520: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
6530: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
6540: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 ring compare [li
6550: 6e 64 65 78 20 24 70 20 30 5d 20 31 32 37 2e 30 ndex $p 0] 127.0
6560: 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e .0.1]. lappen
6570: 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 d l [string comp
6580: 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 are [lindex $p 2
6590: 5d 20 38 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 ] 8820]. lapp
65a0: 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 end l [llength $
65b0: 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a 0a 23 20 p].} {0 0 3}..#
65c0: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
65d0: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
65e0: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
65f0: 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 for '-sockname'
6600: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 32 ..test tlsIO-7.2
6610: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
6620: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
6630: 73 7d 20 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 s} {knownBug soc
6640: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
6650: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
6660: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
6670: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
6680: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
6690: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
66a0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
66b0: 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f "tls::socket -
66c0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
66d0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
66e0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
66f0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
6700: 72 76 65 72 4b 65 79 20 38 38 32 31 22 0a 20 20 rverKey 8821".
6710: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
6720: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
6730: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
6740: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
6750: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
6760: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
6770: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
6780: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
6790: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
67a0: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
67b0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
67c0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
67d0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
67e0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
67f0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
6800: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6810: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
6820: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
6830: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6840: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
6850: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
6860: 30 2e 30 2e 31 20 38 38 32 31 5d 0a 20 20 20 20 0.0.1 8821].
6870: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
6880: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
6890: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
68a0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
68b0: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
68c0: 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 nd l [llength $p
68d0: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
68e0: 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a 20 20 [lindex $p 0].
68f0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 lappend l [str
6900: 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 6e 64 65 ing equal [linde
6910: 78 20 24 70 20 32 5d 20 38 38 32 31 5d 0a 7d 20 x $p 2] 8821].}
6920: 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a {3 127.0.0.1 0}.
6930: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 33 20 .test tlsIO-7.3
6940: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
6950: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
6960: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
6970: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6980: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
6990: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
69a0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
69b0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
69c0: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
69d0: 61 63 63 65 70 74 20 38 38 32 32 5d 0a 20 20 20 accept 8822].
69e0: 20 73 65 74 20 6c 20 5b 66 63 6f 6e 66 69 67 75 set l [fconfigu
69f0: 72 65 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 re $s]. close
6a00: 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 $s. update.
6a10: 20 20 20 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d 20 llength $l.}
6a20: 31 32 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 12..# bug report
6a30: 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 #5812 fconfigur
6a40: 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e e doesn't return
6a50: 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 value for '-soc
6a60: 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 kname'..test tls
6a70: 49 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 20 IO-7.4 {testing
6a80: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
6a90: 6f 70 74 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 6e 42 options} {knownB
6aa0: 75 67 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 ug socket} {.
6ab0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6ac0: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
6ad0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
6ae0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
6af0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
6b00: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
6b10: 61 63 63 65 70 74 20 38 38 32 33 5d 0a 20 20 20 accept 8823].
6b20: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
6b30: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 a p} {..global x
6b40: 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 ..set x [fconfig
6b50: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 ure $s -sockname
6b60: 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 ]..close $s.
6b70: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
6b80: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
6b90: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
6ba0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6bb0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
6bc0: 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 5b 69 entKey \. .[i
6bd0: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 nfo hostname] 88
6be0: 32 33 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 23]. set time
6bf0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
6c00: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
6c10: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
6c20: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
6c30: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
6c40: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
6c50: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
6c60: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
6c70: 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 dex $x 2] [lleng
6c80: 74 68 20 24 78 5d 0a 7d 20 7b 38 38 32 33 20 33 th $x].} {8823 3
6c90: 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 }..# bug report
6ca0: 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 #5812 fconfigure
6cb0: 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 doesn't return
6cc0: 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b value for '-sock
6cd0: 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 name'..test tlsI
6ce0: 4f 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 O-7.5 {testing s
6cf0: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
6d00: 70 74 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 6e 42 75 ptions} {knownBu
6d10: 67 20 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 g socket unixOrP
6d20: 63 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b c} {. set s [
6d30: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
6d40: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
6d50: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6d60: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6d70: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
6d80: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
6d90: 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 829]. proc ac
6da0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
6db0: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
6dc0: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
6dd0: 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 sockname]..close
6de0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
6df0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
6e00: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
6e10: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
6e20: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6e30: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
6e40: 0a 20 20 20 20 09 31 32 37 2e 30 2e 30 2e 31 20 . .127.0.0.1
6e50: 38 38 32 39 5d 0a 20 20 20 20 73 65 74 20 74 69 8829]. set ti
6e60: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
6e70: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
6e80: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
6e90: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
6ea0: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
6eb0: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
6ec0: 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a s1. set l "".
6ed0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
6ee0: 69 6e 64 65 78 20 24 78 20 30 5d 20 5b 6c 69 6e index $x 0] [lin
6ef0: 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 dex $x 2] [lleng
6f00: 74 68 20 24 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e th $x].} {127.0.
6f10: 30 2e 31 20 38 38 32 39 20 33 7d 0a 0a 74 65 73 0.1 8829 3}..tes
6f20: 74 20 74 6c 73 49 4f 2d 38 2e 31 20 7b 74 65 73 t tlsIO-8.1 {tes
6f30: 74 69 6e 67 20 2d 61 73 79 6e 63 20 66 6c 61 67 ting -async flag
6f40: 20 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 7b 75 6e on sockets} {un
6f50: 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f explainedHang so
6f60: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 74 65 cket} {. # te
6f70: 73 74 20 73 65 65 6d 73 20 74 6f 20 68 61 6e 67 st seems to hang
6f80: 20 2d 2d 20 61 77 62 20 36 2f 32 2f 32 30 30 30 -- awb 6/2/2000
6f90: 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 . # NOTE: Thi
6fa0: 73 20 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 s test may fail
6fb0: 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 on some Solaris
6fc0: 32 2e 34 20 73 79 73 74 65 6d 73 2e 20 49 66 20 2.4 systems. If
6fd0: 69 74 20 64 6f 65 73 2c 0a 20 20 20 20 23 20 63 it does,. # c
6fe0: 68 65 63 6b 20 74 68 61 74 20 79 6f 75 20 68 61 heck that you ha
6ff0: 76 65 20 74 68 65 73 65 20 70 61 74 63 68 65 73 ve these patches
7000: 20 69 6e 73 74 61 6c 6c 65 64 20 28 75 73 69 6e installed (usin
7010: 67 20 73 68 6f 77 72 65 76 20 2d 70 29 3a 0a 20 g showrev -p):.
7020: 20 20 20 23 0a 20 20 20 20 23 20 31 30 31 39 30 #. # 10190
7030: 37 2d 30 35 2c 20 31 30 31 39 32 35 2d 30 32 2c 7-05, 101925-02,
7040: 20 31 30 31 39 34 35 2d 31 34 2c 20 31 30 31 39 101945-14, 1019
7050: 35 39 2d 30 33 2c 20 31 30 31 39 36 39 2d 30 35 59-03, 101969-05
7060: 2c 20 31 30 31 39 37 33 2d 30 33 2c 0a 20 20 20 , 101973-03,.
7070: 20 23 20 31 30 31 39 37 37 2d 30 33 2c 20 31 30 # 101977-03, 10
7080: 31 39 38 31 2d 30 32 2c 20 31 30 31 39 38 35 2d 1981-02, 101985-
7090: 30 31 2c 20 31 30 32 30 30 31 2d 30 33 2c 20 31 01, 102001-03, 1
70a0: 30 32 30 30 33 2d 30 31 2c 20 31 30 32 30 30 37 02003-01, 102007
70b0: 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 32 30 31 -01,. # 10201
70c0: 31 2d 30 32 2c 20 31 30 32 30 32 34 2d 30 31 2c 1-02, 102024-01,
70d0: 20 31 30 32 30 33 39 2d 30 31 2c 20 31 30 32 30 102039-01, 1020
70e0: 34 34 2d 30 31 2c 20 31 30 32 30 34 38 2d 30 31 44-01, 102048-01
70f0: 2c 20 31 30 32 30 36 32 2d 30 33 2c 0a 20 20 20 , 102062-03,.
7100: 20 23 20 31 30 32 30 36 36 2d 30 34 2c 20 31 30 # 102066-04, 10
7110: 32 30 37 30 2d 30 31 2c 20 31 30 32 31 30 35 2d 2070-01, 102105-
7120: 30 31 2c 20 31 30 32 31 35 33 2d 30 33 2c 20 31 01, 102153-03, 1
7130: 30 32 32 31 36 2d 30 31 2c 20 31 30 32 32 33 32 02216-01, 102232
7140: 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 31 38 37 -01,. # 10187
7150: 38 2d 30 33 2c 20 31 30 31 38 37 39 2d 30 31 2c 8-03, 101879-01,
7160: 20 31 30 31 38 38 30 2d 30 33 2c 20 31 30 31 39 101880-03, 1019
7170: 33 33 2d 30 31 2c 20 31 30 31 39 35 30 2d 30 31 33-01, 101950-01
7180: 2c 20 31 30 32 30 33 30 2d 30 31 2c 0a 20 20 20 , 102030-01,.
7190: 20 23 20 31 30 32 30 35 37 2d 30 38 2c 20 31 30 # 102057-08, 10
71a0: 32 31 34 30 2d 30 31 2c 20 31 30 31 39 32 30 2d 2140-01, 101920-
71b0: 30 32 2c 20 31 30 31 39 32 31 2d 30 39 2c 20 31 02, 101921-09, 1
71c0: 30 31 39 32 32 2d 30 37 2c 20 31 30 31 39 32 33 01922-07, 101923
71d0: 2d 30 33 0a 20 20 20 20 23 0a 20 20 20 20 23 20 -03. #. #
71e0: 49 66 20 61 66 74 65 72 20 69 6e 73 74 61 6c 6c If after install
71f0: 69 6e 67 20 74 68 65 73 65 20 70 61 74 63 68 65 ing these patche
7200: 73 20 79 6f 75 20 61 72 65 20 73 74 69 6c 6c 20 s you are still
7210: 65 78 70 65 72 69 65 6e 63 69 6e 67 20 61 0a 20 experiencing a.
7220: 20 20 20 23 20 70 72 6f 62 6c 65 6d 2c 20 70 6c # problem, pl
7230: 65 61 73 65 20 65 6d 61 69 6c 20 6a 79 6c 40 65 ease email jyl@e
7240: 6e 67 2e 73 75 6e 2e 63 6f 6d 2e 20 57 65 20 68 ng.sun.com. We h
7250: 61 76 65 20 6e 6f 74 20 6f 62 73 65 72 76 65 64 ave not observed
7260: 20 74 68 69 73 0a 20 20 20 20 23 20 66 61 69 6c this. # fail
7270: 75 72 65 20 6f 6e 20 53 6f 6c 61 72 69 73 20 32 ure on Solaris 2
7280: 2e 35 2c 20 73 6f 20 61 6e 6f 74 68 65 72 20 6f .5, so another o
7290: 70 74 69 6f 6e 20 28 69 6e 73 74 65 61 64 20 6f ption (instead o
72a0: 66 20 69 6e 73 74 61 6c 6c 69 6e 67 0a 20 20 20 f installing.
72b0: 20 23 20 74 68 65 73 65 20 70 61 74 63 68 65 73 # these patches
72c0: 29 20 69 73 20 74 6f 20 75 70 67 72 61 64 65 20 ) is to upgrade
72d0: 74 6f 20 53 6f 6c 61 72 69 73 20 32 2e 35 2e 0a to Solaris 2.5..
72e0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
72f0: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
7300: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
7310: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
7320: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
7330: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 Key \. .-serv
7340: 65 72 20 61 63 63 65 70 74 20 38 38 33 30 5d 0a er accept 8830].
7350: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
7360: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
7370: 6c 20 78 0a 09 70 75 74 73 20 24 73 20 62 79 65 l x..puts $s bye
7380: 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 ..close $s..set
7390: 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 x done. }.
73a0: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
73b0: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
73c0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
73d0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
73e0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
73f0: 79 20 5c 0a 09 2d 61 73 79 6e 63 20 5b 69 6e 66 y \..-async [inf
7400: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 30 o hostname] 8830
7410: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
7420: 20 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 73 set z [gets $s
7430: 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 1]. close $s.
7440: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
7450: 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 set z.} bye..t
7460: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b 74 est tlsIO-9.1 {t
7470: 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 esting spurious
7480: 65 76 65 6e 74 73 7d 20 7b 75 6e 65 78 70 6c 61 events} {unexpla
7490: 69 6e 65 64 48 61 6e 67 20 73 6f 63 6b 65 74 7d inedHang socket}
74a0: 20 7b 0a 20 20 20 20 23 20 6c 6f 63 6b 73 20 75 {. # locks u
74b0: 70 20 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 p . set len 0
74c0: 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 . set spuriou
74d0: 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 s 0. set done
74e0: 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 0. proc read
74f0: 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c little {s} {..gl
7500: 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f obal spurious do
7510: 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 ne len..set l [r
7520: 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b ead $s 1]..if {[
7530: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
7540: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 ] == 0} {.. i
7550: 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a f {![eof $s]} {.
7560: 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a ..incr spurious.
7570: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
7580: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 close $s...set d
7590: 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 one 1.. }..}
75a0: 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 else {.. incr
75b0: 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e len [string len
75c0: 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d gth $l]..}. }
75d0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
75e0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
75f0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
7600: 72 69 6e 67 20 6e 6f 6e 65 20 2d 62 6c 6f 63 6b ring none -block
7610: 69 6e 67 20 6f 66 66 0a 09 66 69 6c 65 65 76 65 ing off..fileeve
7620: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
7630: 6c 69 73 74 20 72 65 61 64 6c 69 74 74 6c 65 20 list readlittle
7640: 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s]. }. se
7650: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
7660: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \..-certfile $s
7670: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
7680: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7690: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
76a0: 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 .-server acce
76b0: 70 74 20 38 38 33 31 5d 0a 20 20 20 20 73 65 74 pt 8831]. set
76c0: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
76d0: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
76e0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
76f0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7700: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
7710: 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 .[info hostna
7720: 6d 65 5d 20 38 38 33 31 5d 0a 20 20 20 20 70 75 me] 8831]. pu
7730: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 ts -nonewline $c
7740: 20 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 012345678901234
7750: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 5678901234567890
7760: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
7770: 37 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 789. close $c
7780: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
7790: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
77a0: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
77b0: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
77c0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
77d0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
77e0: 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 se $s. list $
77f0: 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 spurious $len.}
7800: 7b 30 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 {0 50}..test tls
7810: 49 4f 2d 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 IO-9.2 {testing
7820: 61 73 79 6e 63 20 77 72 69 74 65 2c 20 66 69 6c async write, fil
7830: 65 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f eevents, flush o
7840: 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 74 n close} {socket
7850: 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 69 72 73 } {. set firs
7860: 74 62 6c 6f 63 6b 20 22 22 0a 20 20 20 20 66 6f tblock "". fo
7870: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
7880: 3c 20 35 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 73 < 5} {incr i} {s
7890: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 61 et firstblock "a
78a0: 24 66 69 72 73 74 62 6c 6f 63 6b 24 66 69 72 73 $firstblock$firs
78b0: 74 62 6c 6f 63 6b 22 7d 0a 20 20 20 20 73 65 74 tblock"}. set
78c0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a secondblock "".
78d0: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
78e0: 7d 20 7b 24 69 20 3c 20 31 36 7d 20 7b 69 6e 63 } {$i < 16} {inc
78f0: 72 20 69 7d 20 7b 0a 09 73 65 74 20 73 65 63 6f r i} {..set seco
7900: 6e 64 62 6c 6f 63 6b 20 22 62 24 73 65 63 6f 6e ndblock "b$secon
7910: 64 62 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 6c 6f dblock$secondblo
7920: 63 6b 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ck". }. se
7930: 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t l [tls::socket
7940: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \..-certfile $s
7950: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
7960: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7970: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
7980: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
7990: 65 70 74 20 38 38 33 32 5d 0a 20 20 20 20 70 72 ept 8832]. pr
79a0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
79b0: 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 } {..fconfigure
79c0: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $s -blocking 0 -
79d0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d translation lf -
79e0: 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 buffersize 16384
79f0: 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 \...-buffering
7a00: 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 line..fileevent
7a10: 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $s readable "rea
7a20: 64 61 62 6c 65 20 24 73 22 0a 20 20 20 20 7d 0a dable $s". }.
7a30: 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 62 6c proc readabl
7a40: 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b e {s} {..set l [
7a50: 67 65 74 73 20 24 73 5d 0a 09 66 69 6c 65 65 76 gets $s]..fileev
7a60: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
7a70: 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 30 20 72 {}..after 1000 r
7a80: 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 20 7d 0a espond $s. }.
7a90: 20 20 20 20 70 72 6f 63 20 72 65 73 70 6f 6e 64 proc respond
7aa0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 66 {s} {..global f
7ab0: 69 72 73 74 62 6c 6f 63 6b 0a 09 70 75 74 73 20 irstblock..puts
7ac0: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 -nonewline $s $f
7ad0: 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 74 65 72 irstblock..after
7ae0: 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 20 1000 writedata
7af0: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f $s. }. pro
7b00: 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 c writedata {s}
7b10: 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 {..global second
7b20: 62 6c 6f 63 6b 0a 09 70 75 74 73 20 2d 6e 6f 6e block..puts -non
7b30: 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e ewline $s $secon
7b40: 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 73 dblock..close $s
7b50: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
7b60: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
7b70: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
7b80: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
7b90: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
7ba0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
7bb0: 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 .[info hostname
7bc0: 5d 20 38 38 33 32 5d 0a 20 20 20 20 66 63 6f 6e ] 8832]. fcon
7bd0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
7be0: 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 ing 0 -trans lf
7bf0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
7c00: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a set count 0.
7c10: 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c puts $s hell
7c20: 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 o. proc readi
7c30: 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 t {s} {..global
7c40: 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 count done..set
7c50: 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 l [read $s]..inc
7c60: 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 r count [string
7c70: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b length $l]..if {
7c80: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 [eof $s]} {..
7c90: 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 close $s.. s
7ca0: 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 et done 1..}.
7cb0: 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 }. fileevent
7cc0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 $s readable "re
7cd0: 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 65 74 adit $s". set
7ce0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
7cf0: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
7d00: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
7d10: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
7d20: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
7d30: 0a 20 20 20 20 63 6c 6f 73 65 20 24 6c 0a 20 20 . close $l.
7d40: 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 set count.} 65
7d50: 35 36 36 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 566..test tlsIO-
7d60: 39 2e 33 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 9.3 {testing EOF
7d70: 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e stickyness} {un
7d80: 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f explainedHang so
7d90: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 68 61 cket} {. # ha
7da0: 6e 67 73 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 ngs. proc cou
7db0: 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a nt_to_eof {s} {.
7dc0: 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f .global count do
7dd0: 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 20 6c 20 ne timer..set l
7de0: 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b [gets $s]..if {[
7df0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
7e00: 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 20 20 incr count..
7e10: 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 7d 20 if {$count > 9}
7e20: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 {...close $s...s
7e30: 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 09 73 et done true...s
7e40: 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 69 73 et count {eof is
7e50: 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 sticky}...after
7e60: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
7e70: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
7e80: 20 20 20 70 72 6f 63 20 74 69 6d 65 72 70 72 6f proc timerpro
7e90: 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 c {} {..global d
7ea0: 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 65 74 one count c..set
7eb0: 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 74 20 done true..set
7ec0: 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 65 6e count {timer wen
7ed0: 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 6e 6f t off, eof is no
7ee0: 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 t sticky}..close
7ef0: 20 24 63 0a 20 20 20 20 7d 09 0a 20 20 20 20 73 $c. }.. s
7f00: 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 73 et count 0. s
7f10: 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a 20 20 et done false.
7f20: 20 20 70 72 6f 63 20 77 72 69 74 65 5f 74 68 65 proc write_the
7f30: 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 n_close {s} {..p
7f40: 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 uts $s bye..clos
7f50: 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 e $s. }. p
7f60: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
7f70: 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 p} {..fconfigure
7f80: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
7f90: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
7fa0: 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 lf..fileevent $
7fb0: 73 20 77 72 69 74 61 62 6c 65 20 22 77 72 69 74 s writable "writ
7fc0: 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 24 73 22 e_then_close $s"
7fd0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
7fe0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
7ff0: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
8000: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
8010: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
8020: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 $serverKey \.
8030: 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 .-server accept
8040: 20 38 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 8833]. set c
8050: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8060: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
8070: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
8080: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
8090: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
80a0: 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 .[info hostname
80b0: 5d 20 38 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e ] 8833]. fcon
80c0: 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b figure $c -block
80d0: 69 6e 67 20 6f 66 66 20 2d 62 75 66 66 65 72 69 ing off -bufferi
80e0: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
80f0: 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 tion lf. file
8100: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
8110: 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 e "count_to_eof
8120: 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c". set time
8130: 72 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 r [after 1000 ti
8140: 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 merproc]. vwa
8150: 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 it done. clos
8160: 65 20 24 73 0a 20 20 20 20 73 65 74 20 63 6f 75 e $s. set cou
8170: 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 nt.} {eof is sti
8180: 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 cky}..removeFile
8190: 20 73 63 72 69 70 74 0a 0a 74 65 73 74 20 74 6c script..test tl
81a0: 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e sIO-10.1 {testin
81b0: 67 20 73 6f 63 6b 65 74 20 61 63 63 65 70 74 20 g socket accept
81c0: 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 callback error h
81d0: 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 andling} {socket
81e0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 6f 74 65 } {. set gote
81f0: 72 72 6f 72 20 30 0a 20 20 20 20 70 72 6f 63 20 rror 0. proc
8200: 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 67 6c bgerror args {gl
8210: 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 obal goterror; s
8220: 65 74 20 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 et goterror 1}.
8230: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8240: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
8250: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
8260: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8270: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8280: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
8290: 72 20 61 63 63 65 70 74 20 38 38 39 38 5d 0a 20 r accept 8898].
82a0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
82b0: 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 s a p} {close $s
82c0: 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 ; error}. set
82d0: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
82e0: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
82f0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
8300: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8310: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
8320: 31 32 37 2e 30 2e 30 2e 31 20 38 38 39 38 5d 0a 127.0.0.1 8898].
8330: 20 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 vwait goterr
8340: 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a or. close $s.
8350: 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 close $c.
8360: 20 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 set goterror.}
8370: 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 1..test tlsIO-11
8380: 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .1 {tcp connecti
8390: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 on} {socket doTe
83a0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
83b0: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
83c0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 ommand "set caCe
83d0: 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 rt $caCert".
83e0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
83f0: 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 serverCert $ser
8400: 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e verCert". sen
8410: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
8420: 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 ientCert $client
8430: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
8440: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
8450: 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 rKey $serverKey"
8460: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8470: 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 "set clientKey
8480: 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 $clientKey".
8490: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
84a0: 65 74 20 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 et socket9_1_tes
84b0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
84c0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
84d0: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
84e0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c le $serverCert \
84f0: 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 ...-cafile $caCe
8500: 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 rt \...-keyfile
8510: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 38 $serverKey \...8
8520: 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 834]..proc accep
8530: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
8540: 20 70 75 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 puts $s done..
8550: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
8560: 65 20 24 73 0a 09 20 20 20 20 63 6c 6f 73 65 20 e $s.. close
8570: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
8580: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
8590: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
85a0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
85b0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
85c0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
85d0: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
85e0: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 34 5d teServerIP 8834]
85f0: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
8600: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
8610: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
8620: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
8630: 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 9_1_test_server}
8640: 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e . set r.} don
8650: 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 e..test tlsIO-11
8660: 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 .2 {client speci
8670: 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b fies its port} {
8680: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8690: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
86a0: 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e {. sendComman
86b0: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
86c0: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
86d0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
86e0: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
86f0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8700: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
8710: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
8720: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8730: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
8740: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
8750: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8760: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
8770: 6e 74 4b 65 79 22 0a 20 20 20 20 69 66 20 7b 5b ntKey". if {[
8780: 69 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 info exists port
8790: 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 6f 72 74 0a ]} {..incr port.
87a0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 } else {..se
87b0: 74 20 70 6f 72 74 20 5b 65 78 70 72 20 24 74 6c t port [expr $tl
87c0: 73 53 65 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 sServerPort + [p
87d0: 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 20 7d 0a id]%1024]. }.
87e0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
87f0: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 {..set socket9_2
8800: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
8810: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
8820: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 r accept \...-ce
8830: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
8840: 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 rt \...-cafile $
8850: 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 caCert \...-keyf
8860: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
8870: 0a 09 20 20 20 20 38 38 33 35 5d 0a 09 70 72 6f .. 8835]..pro
8880: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
8890: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
88a0: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 70 dshake $s.. p
88b0: 75 74 73 20 24 73 20 24 70 0a 09 20 20 20 20 63 uts $s $p.. c
88c0: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
88d0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
88e0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
88f0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
8900: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8910: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
8920: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
8930: 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 24 72 -myport $port $r
8940: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
8950: 33 35 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 35]. set r [g
8960: 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ets $s]. clos
8970: 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d e $s. sendCom
8980: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
8990: 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 ket9_2_test_serv
89a0: 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 72 20 3d er}. if {$r =
89b0: 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 65 74 20 = $port} {..set
89c0: 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 20 7d 20 result ok. }
89d0: 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 else {..set resu
89e0: 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 20 7d 0a lt broken. }.
89f0: 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d set result.}
8a00: 20 6f 6b 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 ok.test tlsIO-1
8a10: 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 6f 20 63 1.3 {trying to c
8a20: 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 72 76 65 onnect, no serve
8a30: 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 r} {socket doTes
8a40: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
8a50: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 er} {. set st
8a60: 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b atus ok. if {
8a70: 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 20 5b ![catch {set s [
8a80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
8a90: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
8aa0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
8ab0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8ac0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
8ad0: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
8ae0: 72 49 70 20 38 38 33 36 5d 7d 5d 7d 20 7b 0a 09 rIp 8836]}]} {..
8af0: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 if {![catch {get
8b00: 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 s $s}]} {.. s
8b10: 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e et status broken
8b20: 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 ..}..close $s.
8b30: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 }. set stat
8b40: 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c us.} ok..test tl
8b50: 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 65 sIO-11.4 {remote
8b60: 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d echo, one line}
8b70: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
8b80: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
8b90: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d } {. sendComm
8ba0: 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 and "set caCert
8bb0: 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e $caCert". sen
8bc0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
8bd0: 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 rverCert $server
8be0: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
8bf0: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
8c00: 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 tCert $clientCer
8c10: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
8c20: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 nd "set serverKe
8c30: 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 y $serverKey".
8c40: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8c50: 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c et clientKey $cl
8c60: 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e ientKey". sen
8c70: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 20 20 20 20 09 dCommand {. .
8c80: 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 43 65 72 global serverCer
8c90: 74 0a 09 67 6c 6f 62 61 6c 20 63 61 43 65 72 74 t..global caCert
8ca0: 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 4b ..global serverK
8cb0: 65 79 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 ey..set socket10
8cc0: 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _6_test_server [
8cd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
8ce0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
8cf0: 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c rCert \...-cafil
8d00: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b e $caCert \...-k
8d10: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
8d20: 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 y \...-server ac
8d30: 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 cept 8836]..proc
8d40: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
8d50: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 {.. tls::hand
8d60: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 shake $s.. fi
8d70: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
8d80: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
8d90: 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 s].. fconfigu
8da0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
8db0: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
8dc0: 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 on crlf..}..proc
8dd0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
8de0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
8df0: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
8e00: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
8e10: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
8e20: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 .puts $s $l..
8e30: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
8e40: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
8e50: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
8e60: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
8e70: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
8e80: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
8e90: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
8ea0: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
8eb0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
8ec0: 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $f -translation
8ed0: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
8ee0: 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 20 24 66 line. puts $f
8ef0: 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 74 20 72 hello. set r
8f00: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
8f10: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 lose $f. send
8f20: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
8f30: 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f socket10_6_test_
8f40: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
8f50: 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 73 74 20 r.} hello..test
8f60: 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 65 6d 6f tlsIO-11.5 {remo
8f70: 74 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 6e 65 te echo, 50 line
8f80: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
8f90: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
8fa0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
8fb0: 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 mmand "set caCer
8fc0: 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 t $caCert". s
8fd0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
8fe0: 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 serverCert $serv
8ff0: 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 erCert". send
9000: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
9010: 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 entCert $clientC
9020: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
9030: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
9040: 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a Key $serverKey".
9050: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9060: 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 "set clientKey $
9070: 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 clientKey". s
9080: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
9090: 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 t socket10_7_tes
90a0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
90b0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
90c0: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
90d0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c le $serverCert \
90e0: 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 ...-cafile $caCe
90f0: 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 rt \...-keyfile
9100: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 38 $serverKey \...8
9110: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
9120: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
9130: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
9140: 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e $s.. fileeven
9150: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
9160: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 ist echo $s]..
9170: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
9180: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
9190: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
91a0: 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 f..}..proc echo
91b0: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
91c0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
91d0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
91e0: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
91f0: 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 } else {...puts
9200: 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a $s $l.. }..}.
9210: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 }. set f
9220: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9230: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
9240: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
9250: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9260: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
9270: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
9280: 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 erIP 8836]. f
9290: 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 configure $f -tr
92a0: 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d anslation crlf -
92b0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
92c0: 20 20 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 for {set cnt
92d0: 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 0} {$cnt < 50} {
92e0: 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 incr cnt} {..put
92f0: 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e s $f "hello, $cn
9300: 74 22 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 t"..if {[string
9310: 63 6f 6d 70 61 72 65 20 5b 67 65 74 73 20 24 66 compare [gets $f
9320: 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d ] "hello, $cnt"]
9330: 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 != 0} {.. br
9340: 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 eak..}. }.
9350: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
9360: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
9370: 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 $socket10_7_tes
9380: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
9390: 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 t cnt.} 50..# Ma
93a0: 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 cintosh sockets
93b0: 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 can have more th
93c0: 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 an one server pe
93d0: 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f r port.if {$tcl_
93e0: 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 platform(platfor
93f0: 6d 29 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 m) == "macintosh
9400: 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e "} {. set con
9410: 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 30 20 38 flictResult {0 8
9420: 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 836}.} else {.
9430: 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 set conflictRe
9440: 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 sult {1 {couldn'
9450: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 t open socket: a
9460: 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 ddress already i
9470: 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 n use}}.}..test
9480: 74 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b tlsIO-11.6 {sock
9490: 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f et conflict} {so
94a0: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
94b0: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
94c0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
94d0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
94e0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
94f0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9500: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
9510: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
9520: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
9530: 38 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 836]. if {[ca
9540: 74 63 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 tch {set s2 [tls
9550: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9560: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
9570: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
9580: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9590: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
95a0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
95b0: 38 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 8836]} msg]} {..
95c0: 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 set result [list
95d0: 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 1 $msg]. } e
95e0: 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c lse {..set resul
95f0: 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 t [list 0 [linde
9600: 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 x [fconfigure $s
9610: 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 2 -sockname] 2]]
9620: 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 ..close $s2.
9630: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a }. close $s1.
9640: 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d set result.}
9650: 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 $conflictResult
9660: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
9670: 37 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 7 {server with s
9680: 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 everal clients}
9690: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
96a0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
96b0: 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 {. sendComma
96c0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
96d0: 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 10_9_test_server
96e0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
96f0: 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c ..-certfile [fil
9700: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
9710: 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c ts server.pem] \
9720: 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 ...-cafile [file
9730: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9740: 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a s caFile.pem] \.
9750: 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 ..-keyfile [file
9760: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9770: 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 s skey.pem] \...
9780: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
9790: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
97a0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
97b0: 20 23 20 68 61 6e 64 73 68 61 6b 65 20 6c 6f 63 # handshake loc
97c0: 6b 73 20 75 70 20 74 68 65 20 74 68 72 65 65 20 ks up the three
97d0: 73 79 6e 63 68 72 6f 6e 6f 75 73 20 63 6c 69 65 synchronous clie
97e0: 6e 74 73 0a 09 20 20 20 20 23 20 74 6c 73 3a 3a nts.. # tls::
97f0: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
9800: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
9810: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
9820: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
9830: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
9840: 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 echo $s]..}..pr
9850: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
9860: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
9870: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
9880: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
9890: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
98a0: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
98b0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
98c0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
98d0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
98e0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
98f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9900: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9910: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9920: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
9930: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
9940: 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e re $s1 -bufferin
9950: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
9960: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 2 [tls::socket \
9970: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9980: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9990: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
99a0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
99b0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
99c0: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
99d0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 fconfigure $s2
99e0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
99f0: 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a set s3 [tls:
9a00: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
9a10: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
9a20: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9a30: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
9a40: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
9a50: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
9a60: 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8836]. fconfi
9a70: 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 gure $s3 -buffer
9a80: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 ing line. for
9a90: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
9aa0: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
9ab0: 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f ..puts $s1 hello
9ac0: 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 ,s1..gets $s1..p
9ad0: 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 uts $s2 hello,s2
9ae0: 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 ..gets $s2..puts
9af0: 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 $s3 hello,s3..g
9b00: 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ets $s3. }.
9b10: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
9b20: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
9b30: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
9b40: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
9b50: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
9b60: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
9b70: 69 0a 7d 20 31 30 30 20 20 20 20 0a 0a 74 65 73 i.} 100 ..tes
9b80: 74 20 74 6c 73 49 4f 2d 31 31 2e 38 20 7b 63 6c t tlsIO-11.8 {cl
9b90: 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 ient with severa
9ba0: 6c 20 73 65 72 76 65 72 73 7d 20 7b 75 6e 65 78 l servers} {unex
9bb0: 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f 63 6b plainedHang sock
9bc0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9bd0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9be0: 20 20 23 20 74 68 69 73 20 6f 6e 65 20 73 65 65 # this one see
9bf0: 6d 73 20 74 6f 20 68 61 6e 67 20 2d 2d 20 61 77 ms to hang -- aw
9c00: 62 20 36 2f 32 2f 32 30 30 30 0a 20 20 20 20 73 b 6/2/2000. s
9c10: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
9c20: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
9c30: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
9c40: 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d [file join [pwd]
9c50: 20 63 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 certs server.pe
9c60: 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b m] \...-cafile [
9c70: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9c80: 63 65 72 74 73 20 63 61 46 69 6c 65 2e 70 65 6d certs caFile.pem
9c90: 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b ] \...-keyfile [
9ca0: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9cb0: 63 65 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 certs skey.pem]
9cc0: 5c 0a 09 09 2d 73 65 72 76 65 72 20 22 61 63 63 \...-server "acc
9cd0: 65 70 74 20 34 30 30 33 22 20 34 30 30 33 5d 0a ept 4003" 4003].
9ce0: 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f .set s2 [tls::so
9cf0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
9d00: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
9d10: 77 64 5d 20 63 65 72 74 73 20 73 65 72 76 65 72 wd] certs server
9d20: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 6c .pem] \...-cafil
9d30: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
9d40: 64 5d 20 63 65 72 74 73 20 63 61 46 69 6c 65 2e d] certs caFile.
9d50: 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 6c pem] \...-keyfil
9d60: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
9d70: 64 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 65 d] certs skey.pe
9d80: 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 22 m] \...-server "
9d90: 61 63 63 65 70 74 20 34 30 30 34 22 20 34 30 30 accept 4004" 400
9da0: 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 6c 73 3a 4]..set s3 [tls:
9db0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
9dc0: 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e tfile [file join
9dd0: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 65 72 [pwd] certs ser
9de0: 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 ver.pem] \...-ca
9df0: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
9e00: 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 46 69 [pwd] certs caFi
9e10: 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 le.pem] \...-key
9e20: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
9e30: 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b 65 79 [pwd] certs skey
9e40: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 .pem] \...-serve
9e50: 72 20 22 61 63 63 65 70 74 20 34 30 30 35 22 20 r "accept 4005"
9e60: 34 30 30 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 4005]..proc acce
9e70: 70 74 20 7b 6d 70 20 73 20 61 20 70 7d 20 7b 0a pt {mp s a p} {.
9e80: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
9e90: 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 ake $s.. puts
9ea0: 20 24 73 20 24 6d 70 0a 09 20 20 20 20 63 6c 6f $s $mp.. clo
9eb0: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
9ec0: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
9ed0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9ee0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9ef0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9f00: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9f10: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
9f20: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 remoteServerIP 4
9f30: 30 30 33 5d 0a 20 20 20 20 73 65 74 20 73 32 20 003]. set s2
9f40: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9f50: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
9f60: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
9f70: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9f80: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
9f90: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
9fa0: 65 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 73 erIP 4004]. s
9fb0: 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s3 [tls::sock
9fc0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
9fd0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
9fe0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9ff0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a000: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
a010: 74 65 53 65 72 76 65 72 49 50 20 34 30 30 35 5d teServerIP 4005]
a020: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
a030: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 65 74 lappend l [get
a040: 73 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 31 s $s1] [gets $s1
a050: 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 65 74 ] [eof $s1] [get
a060: 73 20 24 73 32 5d 20 5b 67 65 74 73 20 24 73 32 s $s2] [gets $s2
a070: 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a 09 5b ] [eof $s2] \..[
a080: 67 65 74 73 20 24 73 33 5d 20 5b 67 65 74 73 20 gets $s3] [gets
a090: 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d 0a 20 $s3] [eof $s3].
a0a0: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
a0b0: 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 close $s2. c
a0c0: 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e lose $s3. sen
a0d0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 dCommand {..clos
a0e0: 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 73 32 e $s1..close $s2
a0f0: 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 ..close $s3.
a100: 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 34 }. set l.} {4
a110: 30 30 33 20 7b 7d 20 31 20 34 30 30 34 20 7b 7d 003 {} 1 4004 {}
a120: 20 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 1 4005 {} 1}..t
a130: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 39 20 7b est tlsIO-11.9 {
a140: 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 accept callback
a150: 65 72 72 6f 72 7d 20 7b 6b 6e 6f 77 6e 42 75 67 error} {knownBug
a160: 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 socket doTestsW
a170: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a180: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
a190: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
a1a0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
a1b0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
a1c0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a1d0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
a1e0: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
a1f0: 20 38 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 8836]. proc
a200: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
a210: 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 expr 10 / 0}.
a220: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
a230: 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 gs {..global x..
a240: 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 set x $args.
a250: 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e }. sendComman
a260: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
a270: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
a280: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
a290: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
a2a0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
a2b0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
a2c0: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
a2d0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a2e0: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
a2f0: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
a300: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a310: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
a320: 6e 74 4b 65 79 22 0a 20 20 20 20 69 66 20 7b 5b ntKey". if {[
a330: 63 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 catch {sendComma
a340: 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 nd {.. set pe
a350: 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 ername [fconfigu
a360: 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 re $callerSocket
a370: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 -peername]..
a380: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
a390: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
a3a0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 5c 0a e $clientCert \.
a3b0: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
a3c0: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
a3d0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
a3e0: 20 09 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 6e .[lindex $peern
a3f0: 61 6d 65 20 30 5d 20 38 38 33 36 5d 0a 09 20 20 ame 0] 8836]..
a400: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 close $s. .
a410: 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f }} msg]} {..clo
a420: 73 65 20 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 se $s..error $ms
a430: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
a440: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
a450: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
a460: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
a470: 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 x. after canc
a480: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
a490: 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d ose $s. renam
a4a0: 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 e bgerror {}.
a4b0: 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 set x.} {{divid
a4c0: 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 e by zero}}..tes
a4d0: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 20 7b 74 t tlsIO-11.10 {t
a4e0: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
a4f0: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
a500: 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 6c {unexplainedFail
a510: 75 72 65 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 ure socket doTes
a520: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a530: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
a540: 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 mmand "set caCer
a550: 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 t $caCert". s
a560: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
a570: 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 serverCert $serv
a580: 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 erCert". send
a590: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
a5a0: 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 entCert $clientC
a5b0: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a5c0: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
a5d0: 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a Key $serverKey".
a5e0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a5f0: 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 "set clientKey $
a600: 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 clientKey". s
a610: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
a620: 74 20 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 t socket10_12_te
a630: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
a640: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
a650: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
a660: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 \...-cafile $ca
a670: 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c Cert \...-keyfil
a680: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
a690: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
a6a0: 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 8836]..proc acce
a6b0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 pt {s a p} {clos
a6c0: 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 e $s}. }.
a6d0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
a6e0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
a6f0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
a700: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a710: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a720: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
a730: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
a740: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
a750: 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e figure $s -peern
a760: 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b ame]. set n [
a770: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
a780: 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 ockname]. set
a790: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
a7a0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 d l [lindex $p 2
a7b0: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b ] [llength $p] [
a7c0: 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 llength $p].
a7d0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e close $s. sen
a7e0: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
a7f0: 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 $socket10_12_tes
a800: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
a810: 74 20 6c 0a 7d 20 7b 38 38 33 36 20 33 20 33 7d t l.} {8836 3 3}
a820: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
a830: 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 11 {testing spur
a840: 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 75 6e ious events} {un
a850: 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f explainedHang so
a860: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
a870: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
a880: 20 20 20 20 23 20 68 61 6e 67 73 0a 20 20 20 20 # hangs.
a890: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a8a0: 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 caCert $caCert"
a8b0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a8c0: 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 "set serverCert
a8d0: 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 $serverCert".
a8e0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
a8f0: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 et clientCert $c
a900: 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 lientCert". s
a910: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
a920: 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 serverKey $serve
a930: 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f rKey". sendCo
a940: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
a950: 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 tKey $clientKey"
a960: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a970: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
a980: 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 65 72 20 _13_test_server
a990: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a9a0: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
a9b0: 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 erCert \...-cafi
a9c0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d le $caCert \...-
a9d0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
a9e0: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
a9f0: 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f ccept 8836]..pro
aa00: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
aa10: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
aa20: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 dshake $s.. f
aa30: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
aa40: 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f 20 anslation "auto
aa50: 6c 66 22 0a 09 20 20 20 20 61 66 74 65 72 20 31 lf".. after 1
aa60: 30 30 20 77 72 69 74 65 73 6f 6d 65 20 24 73 0a 00 writesome $s.
aa70: 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 73 6f .}..proc writeso
aa80: 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 66 6f me {s} {.. fo
aa90: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
aaa0: 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 < 100} {incr i}
aab0: 7b 0a 09 09 70 75 74 73 20 24 73 20 22 6c 69 6e {...puts $s "lin
aac0: 65 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f 74 65 e $i from remote
aad0: 20 73 65 72 76 65 72 22 0a 09 20 20 20 20 7d 0a server".. }.
aae0: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d . close $s..}
aaf0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c . }. set l
ab00: 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 en 0. set spu
ab10: 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 rious 0. set
ab20: 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 done 0. proc
ab30: 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b readlittle {s} {
ab40: 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 ..global spuriou
ab50: 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 s done len..set
ab60: 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 l [read $s 1]..i
ab70: 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 f {[string lengt
ab80: 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 h $l] == 0} {..
ab90: 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d if {![eof $s]
aba0: 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 } {...incr spuri
abb0: 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ous.. } else
abc0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 {...close $s...s
abd0: 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d et done 1.. }
abe0: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
abf0: 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 incr len [string
ac00: 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 length $l]..}.
ac10: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b }. set c [
ac20: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
ac30: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
ac40: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
ac50: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
ac60: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
ac70: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
ac80: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 69 rIP 8836]. fi
ac90: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
aca0: 62 6c 65 20 22 72 65 61 64 6c 69 74 74 6c 65 20 ble "readlittle
acb0: 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c". set time
acc0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
acd0: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
ace0: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
acf0: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
ad00: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
ad10: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
ad20: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 33 5f se $socket10_13_
ad30: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
ad40: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
ad50: 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a $len.} {0 2690}.
ad60: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
ad70: 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 2 {testing EOF s
ad80: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 6b 6e 6f 77 tickyness} {know
ad90: 6e 42 75 67 20 73 6f 63 6b 65 74 20 64 6f 54 65 nBug socket doTe
ada0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
adb0: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 ver} {. set c
adc0: 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 73 65 74 ounter 0. set
add0: 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 done 0. proc
ade0: 20 63 6f 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a count_up {s} {.
adf0: 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 .global counter
ae00: 64 6f 6e 65 20 61 66 74 65 72 5f 69 64 0a 09 73 done after_id..s
ae10: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
ae20: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
ae30: 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 . incr counte
ae40: 72 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e r.. if {$coun
ae50: 74 65 72 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 ter > 9} {...set
ae60: 20 64 6f 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 done {EOF is st
ae70: 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 icky}...after ca
ae80: 6e 63 65 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 ncel $after_id..
ae90: 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d .close $s.. }
aea0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ..}. }. pr
aeb0: 6f 63 20 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 oc timed_out {}
aec0: 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 {..global c done
aed0: 0a 09 73 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 ..set done {time
aee0: 64 5f 6f 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f d_out, EOF is no
aef0: 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 t sticky}..close
af00: 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $c. }. se
af10: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
af20: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
af30: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
af40: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
af50: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
af60: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
af70: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
af80: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
af90: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
afa0: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
afb0: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
afc0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
afd0: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
afe0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
aff0: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 ..set socket10_1
b000: 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 4_test_server [t
b010: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
b020: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
b030: 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 Cert \...-cafile
b040: 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 $caCert \...-ke
b050: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
b060: 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 \...-server acc
b070: 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 ept 8836]..proc
b080: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
b090: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
b0a0: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 61 66 74 hake $s.. aft
b0b0: 65 72 20 31 30 30 20 63 6c 6f 73 65 20 24 73 0a er 100 close $s.
b0c0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
b0d0: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
b0e0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
b0f0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
b100: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
b110: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
b120: 20 5c 0a 20 20 20 20 09 24 72 65 6d 6f 74 65 53 \. .$remoteS
b130: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
b140: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
b150: 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 eadable "count_u
b160: 70 20 24 63 22 0a 20 20 20 20 73 65 74 20 61 66 p $c". set af
b170: 74 65 72 5f 69 64 20 5b 61 66 74 65 72 20 31 30 ter_id [after 10
b180: 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 00 timed_out].
b190: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
b1a0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
b1b0: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 ose $socket10_14
b1c0: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
b1d0: 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f set done.} {EO
b1e0: 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 74 65 F is sticky}..te
b1f0: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 33 20 7b st tlsIO-11.13 {
b200: 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 testing async wr
b210: 69 74 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 ite, async flush
b220: 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c , async close} \
b230: 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 ..{socket doTest
b240: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
b250: 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 r} {. proc re
b260: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
b270: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 al count done..s
b280: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 et l [read $s]..
b290: 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 incr count [stri
b2a0: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 ng length $l]..i
b2b0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
b2c0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 close $s..
b2d0: 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a set done 1..}.
b2e0: 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f }. sendCo
b2f0: 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 mmand "set caCer
b300: 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 t $caCert". s
b310: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
b320: 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 serverCert $serv
b330: 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 erCert". send
b340: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
b350: 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 entCert $clientC
b360: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
b370: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
b380: 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a Key $serverKey".
b390: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b3a0: 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 "set clientKey $
b3b0: 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 clientKey". s
b3c0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
b3d0: 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a t firstblock "".
b3e0: 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b .for {set i 0} {
b3f0: 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 20 69 7d $i < 5} {incr i}
b400: 20 7b 0a 09 09 73 65 74 20 66 69 72 73 74 62 6c {...set firstbl
b410: 6f 63 6b 20 22 61 24 66 69 72 73 74 62 6c 6f 63 ock "a$firstbloc
b420: 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 0a 09 7d k$firstblock"..}
b430: 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 ..set secondbloc
b440: 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 k ""..for {set i
b450: 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d 20 7b 69 0} {$i < 16} {i
b460: 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 73 65 ncr i} {.. se
b470: 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 t secondblock "b
b480: 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 $secondblock$sec
b490: 6f 6e 64 62 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 ondblock"..}..se
b4a0: 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t l [tls::socket
b4b0: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
b4c0: 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d serverCert \...-
b4d0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
b4e0: 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 ...-keyfile $ser
b4f0: 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 verKey \...-serv
b500: 65 72 20 61 63 63 65 70 74 20 38 38 34 35 5d 0a er accept 8845].
b510: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
b520: 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a a p} {.. tls:
b530: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
b540: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
b550: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 -blocking 0 -tr
b560: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 anslation lf -bu
b570: 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 20 5c ffersize 16384 \
b580: 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 ...-buffering li
b590: 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e ne.. fileeven
b5a0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
b5b0: 65 61 64 61 62 6c 65 20 24 73 22 0a 09 7d 0a 09 eadable $s"..}..
b5c0: 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 proc readable {s
b5d0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
b5e0: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 66 69 gets $s].. fi
b5f0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
b600: 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 66 74 65 ble {}.. afte
b610: 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 r 1000 respond $
b620: 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 73 70 6f s..}..proc respo
b630: 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c nd {s} {.. gl
b640: 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a obal firstblock.
b650: 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
b660: 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c line $s $firstbl
b670: 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 72 20 31 ock.. after 1
b680: 30 30 30 20 77 72 69 74 65 64 61 74 61 20 24 73 000 writedata $s
b690: 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 64 ..}..proc writed
b6a0: 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 ata {s} {.. g
b6b0: 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 lobal secondbloc
b6c0: 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e k.. puts -non
b6d0: 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f 6e ewline $s $secon
b6e0: 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 6c 6f 73 dblock.. clos
b6f0: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
b700: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
b710: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
b720: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
b730: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
b740: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
b750: 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 24 72 65 ntKey \. .$re
b760: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 34 moteServerIP 884
b770: 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 5]. fconfigur
b780: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
b790: 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 -trans lf -buff
b7a0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
b7b0: 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 et count 0. p
b7c0: 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 uts $s hello.
b7d0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
b7e0: 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 adable "readit $
b7f0: 73 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 s". set timer
b800: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
b810: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
b820: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f t"]. vwait do
b830: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
b840: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 cel $timer. s
b850: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
b860: 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 6f e $l}. set co
b870: 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 unt.} 65566..tes
b880: 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 65 t tlsIO-12.1 {te
b890: 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 sting inheritanc
b8a0: 65 20 6f 66 20 73 65 72 76 65 72 20 73 6f 63 6b e of server sock
b8b0: 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ets} \..{socket
b8c0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
b8d0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 eServer} {. r
b8e0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
b8f0: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
b900: 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 script2.. #
b910: 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 Script1 is just
b920: 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 a 10 second dela
b930: 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 65 y. If the serve
b940: 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 r socket. # i
b950: 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 s inherited, it
b960: 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 will be held ope
b970: 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 n for 10 seconds
b980: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
b990: 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 n script1 w].
b9a0: 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 puts $f {..afte
b9b0: 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 r 10000 exit..vw
b9c0: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
b9d0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
b9e0: 20 20 20 20 23 20 53 63 72 69 70 74 32 20 63 72 # Script2 cr
b9f0: 65 61 74 65 73 20 74 68 65 20 73 65 72 76 65 72 eates the server
ba00: 20 73 6f 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 socket, launche
ba10: 73 20 73 63 72 69 70 74 31 2c 0a 20 20 20 20 23 s script1,. #
ba20: 20 77 61 69 74 73 20 61 20 73 65 63 6f 6e 64 2c waits a second,
ba30: 20 61 6e 64 20 65 78 69 74 73 2e 20 20 54 68 65 and exits. The
ba40: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 server socket w
ba50: 69 6c 6c 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 ill now. # be
ba60: 20 63 6c 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 closed unless s
ba70: 63 72 69 70 74 31 20 69 6e 68 65 72 69 74 65 64 cript1 inherited
ba80: 20 69 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 it... set f
ba90: 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d [open script2 w]
baa0: 0a 20 20 20 20 23 20 70 75 74 73 20 24 66 20 5b . # puts $f [
bab0: 6c 69 73 74 20 73 65 74 20 74 63 6c 74 65 73 74 list set tcltest
bac0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
bad0: 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 test]. puts $
bae0: 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 f [list set tcls
baf0: 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 h [info nameofex
bb00: 65 63 75 74 61 62 6c 65 5d 5d 0a 20 20 20 20 70 ecutable]]. p
bb10: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
bb20: 65 20 72 65 71 75 69 72 65 20 74 63 6c 74 65 73 e require tcltes
bb30: 74 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 t..package requi
bb40: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
bb50: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
bb60: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
bb70: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
bb80: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
bb90: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
bba0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
bbb0: 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a verKey 8828 \]".
bbc0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
bbd0: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
bbe0: 65 20 61 64 64 72 20 70 6f 72 74 20 7d 20 7b 0a e addr port } {.
bbf0: 09 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 . close $file
bc00: 0a 09 7d 0a 09 23 20 65 78 65 63 20 24 3a 3a 74 ..}..# exec $::t
bc10: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
bc20: 73 63 72 69 70 74 31 20 26 0a 09 65 78 65 63 20 script1 &..exec
bc30: 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 $tclsh script1 &
bc40: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 ..close $f..afte
bc50: 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 r 1000 exit..vwa
bc60: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
bc70: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 09 0a . close $f...
bc80: 20 20 20 20 23 20 4c 61 75 6e 63 68 20 73 63 72 # Launch scr
bc90: 69 70 74 32 20 61 6e 64 20 77 61 69 74 20 35 20 ipt2 and wait 5
bca0: 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 23 20 65 seconds.. # e
bcb0: 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a xec $::tcltest::
bcc0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 tcltest script2
bcd0: 26 0a 20 20 20 20 65 78 65 63 20 5b 69 6e 66 6f &. exec [info
bce0: 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c nameofexecutabl
bcf0: 65 5d 20 73 63 72 69 70 74 32 20 26 0a 20 20 20 e] script2 &.
bd00: 20 61 66 74 65 72 20 35 30 30 30 20 7b 20 73 65 after 5000 { se
bd10: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 t ok_to_proceed
bd20: 31 20 7d 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 1 }. vwait ok
bd30: 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 _to_proceed..
bd40: 20 23 20 49 66 20 77 65 20 63 61 6e 20 73 74 69 # If we can sti
bd50: 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 ll connect to th
bd60: 65 20 73 65 72 76 65 72 2c 20 74 68 65 20 73 6f e server, the so
bd70: 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 69 74 cket got inherit
bd80: 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 ed... if {[ca
bd90: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
bda0: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
bdb0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
bdc0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
bdd0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
bde0: 20 20 20 09 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
bdf0: 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 828} msg]} {..se
be00: 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b t x {server sock
be10: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
be20: 69 74 65 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 ited}. } else
be30: 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 {..close $msg..
be40: 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f set x {server so
be50: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
be60: 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 72 ed}. }.. r
be70: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
be80: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
be90: 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 script2. set
bea0: 20 78 0a 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 x.} {server soc
beb0: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
bec0: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 rited}..test tls
bed0: 49 4f 2d 31 32 2e 32 20 7b 74 65 73 74 69 6e 67 IO-12.2 {testing
bee0: 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 inheritance of
bef0: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 73 7d 20 client sockets}
bf00: 5c 0a 09 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 \..{unexplainedF
bf10: 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 6f ailure socket do
bf20: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
bf30: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d erver} {. rem
bf40: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
bf50: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
bf60: 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 cript2.. # Sc
bf70: 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 ript1 is just a
bf80: 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 10 second delay.
bf90: 20 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 If the server
bfa0: 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 socket. # is
bfb0: 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 inherited, it wi
bfc0: 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 ll be held open
bfd0: 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a for 10 seconds..
bfe0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
bff0: 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 script1 w]. p
c000: 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 uts $f {..after
c010: 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 10000 exit..vwai
c020: 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a t forever. }.
c030: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
c040: 20 20 23 20 53 63 72 69 70 74 32 20 6f 70 65 6e # Script2 open
c050: 73 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 s the client soc
c060: 6b 65 74 20 61 6e 64 20 77 72 69 74 65 73 20 74 ket and writes t
c070: 6f 20 69 74 2e 20 20 49 74 20 74 68 65 6e 0a 20 o it. It then.
c080: 20 20 20 23 20 6c 61 75 6e 63 68 65 73 20 73 63 # launches sc
c090: 72 69 70 74 31 20 61 6e 64 20 65 78 69 74 73 2e ript1 and exits.
c0a0: 20 20 49 66 20 74 68 65 20 63 68 69 6c 64 20 70 If the child p
c0b0: 72 6f 63 65 73 73 20 69 6e 68 65 72 69 74 65 64 rocess inherited
c0c0: 20 74 68 65 0a 20 20 20 20 23 20 63 6c 69 65 6e the. # clien
c0d0: 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 73 6f t socket, the so
c0e0: 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c 6c 20 cket will still
c0f0: 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 73 65 be open... se
c100: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
c110: 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 2 w]. puts $f
c120: 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 [list set tclsh
c130: 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 [info nameofexe
c140: 63 75 74 61 62 6c 65 5d 5d 0a 20 20 20 20 70 75 cutable]]. pu
c150: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
c160: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
c170: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
c180: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
c190: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
c1a0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
c1b0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
c1c0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
c1d0: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 y 127.0.0.1 8829
c1e0: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
c1f0: 20 7b 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 {..exec $tclsh
c200: 73 63 72 69 70 74 31 20 26 0a 09 70 75 74 73 20 script1 &..puts
c210: 24 66 20 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 $f testing..flus
c220: 68 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 h $f..after 1000
c230: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
c240: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
c250: 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 43 lose $f.. # C
c260: 72 65 61 74 65 20 74 68 65 20 73 65 72 76 65 72 reate the server
c270: 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 socket.. set
c280: 20 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f server [tls::so
c290: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
c2a0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
c2b0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
c2c0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
c2d0: 79 20 5c 0a 09 2d 73 65 72 76 65 72 20 61 63 63 y \..-server acc
c2e0: 65 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 72 ept 8829]. pr
c2f0: 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 oc accept { file
c300: 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 0a host port } {..
c310: 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c 69 65 .# When the clie
c320: 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 nt connects, est
c330: 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 64 20 ablish the read
c340: 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 handler..global
c350: 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 server..close $s
c360: 65 72 76 65 72 0a 09 66 69 6c 65 65 76 65 6e 74 erver..fileevent
c370: 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 $file readable
c380: 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 24 66 [list getdata $f
c390: 69 6c 65 5d 0a 09 66 63 6f 6e 66 69 67 75 72 65 ile]..fconfigure
c3a0: 20 24 66 69 6c 65 20 2d 62 75 66 66 65 72 69 6e $file -bufferin
c3b0: 67 20 6c 69 6e 65 20 2d 62 6c 6f 63 6b 69 6e 67 g line -blocking
c3c0: 20 30 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0..return. }
c3d0: 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 61 74 . proc getdat
c3e0: 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 a { file } {...#
c3f0: 20 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e Read handler on
c400: 20 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f the accepted so
c410: 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a cket...global x.
c420: 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 09 .global failed..
c430: 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 set status [catc
c440: 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 h {read $file} d
c450: 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 75 ata]..if {$statu
c460: 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 s != 0} {.. s
c470: 65 74 20 78 20 7b 72 65 61 64 20 66 61 69 6c 65 et x {read faile
c480: 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 61 d, error was $da
c490: 74 61 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b ta}.. catch {
c4a0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
c4b0: 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e } elseif {[strin
c4c0: 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 g compare {} $da
c4d0: 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 ta]} {..} elseif
c4e0: 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c {[fblocked $fil
c4f0: 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 e]} {..} elseif
c500: 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a {[eof $file]} {.
c510: 09 20 20 20 20 69 66 20 7b 24 66 61 69 6c 65 64 . if {$failed
c520: 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 } {...set x {cli
c530: 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 69 ent socket was i
c540: 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d nherited}.. }
c550: 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 20 else {...set x
c560: 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 {client socket w
c570: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
c580: 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 61 }.. }.. ca
c590: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
c5a0: 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 e }..} else {..
c5b0: 20 20 20 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 set x {imposs
c5c0: 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 20 20 ible case}..
c5d0: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
c5e0: 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e ile }..}..return
c5f0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 49 66 . }.. # If
c600: 20 74 68 65 20 73 6f 63 6b 65 74 20 64 6f 65 73 the socket does
c610: 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 2d 66 n't hit end-of-f
c620: 69 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e 64 73 ile in 5 seconds
c630: 2c 20 74 68 65 0a 20 20 20 20 23 20 73 63 72 69 , the. # scri
c640: 70 74 31 20 70 72 6f 63 65 73 73 20 6d 75 73 74 pt1 process must
c650: 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 have inherited
c660: 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 the client...
c670: 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 set failed 0.
c680: 20 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 after 5000 [li
c690: 73 74 20 73 65 74 20 66 61 69 6c 65 64 20 31 5d st set failed 1]
c6a0: 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 .. # Launch t
c6b0: 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 he script2 proce
c6c0: 73 73 0a 0a 20 20 20 20 65 78 65 63 20 5b 69 6e ss.. exec [in
c6d0: 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 fo nameofexecuta
c6e0: 62 6c 65 5d 20 73 63 72 69 70 74 32 20 26 0a 0a ble] script2 &..
c6f0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
c700: 69 66 20 7b 21 24 66 61 69 6c 65 64 7d 20 7b 0a if {!$failed} {.
c710: 09 76 77 61 69 74 20 66 61 69 6c 65 64 0a 20 20 .vwait failed.
c720: 20 20 7d 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 }. removeFi
c730: 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 le script1. r
c740: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
c750: 32 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 2. set x.} {c
c760: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 lient socket was
c770: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
c780: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 33 .test tlsIO-12.3
c790: 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 {testing inheri
c7a0: 74 61 6e 63 65 20 6f 66 20 61 63 63 65 70 74 65 tance of accepte
c7b0: 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 68 d sockets} \..{h
c7c0: 61 6e 67 73 4f 6e 4c 69 6e 75 78 20 73 6f 63 6b angsOnLinux sock
c7d0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
c7e0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
c7f0: 20 20 23 20 68 61 6e 67 73 20 6f 6e 20 4c 69 6e # hangs on Lin
c800: 75 78 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c ux. removeFil
c810: 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 e script1. re
c820: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 moveFile script2
c830: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
c840: 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 n script1 w].
c850: 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 puts $f {..afte
c860: 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 r 10000 exit..vw
c870: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
c880: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
c890: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
c8a0: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 script2 w]. p
c8b0: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
c8c0: 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d tclsh [info nam
c8d0: 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a eofexecutable]].
c8e0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
c8f0: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
c900: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
c910: 20 70 75 74 73 20 24 66 20 22 63 61 74 63 68 20 puts $f "catch
c920: 7b 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f {set f \[tls::so
c930: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
c940: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
c950: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
c960: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
c970: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 39 le $serverKey 89
c980: 33 30 20 5c 5d 7d 22 0a 20 20 20 20 70 75 74 73 30 \]}". puts
c990: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
c9a0: 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 pt { file host p
c9b0: 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f ort } {.. glo
c9c0: 62 61 6c 20 74 63 6c 73 68 0a 09 20 20 20 20 70 bal tclsh.. p
c9d0: 75 74 73 20 24 66 69 6c 65 20 7b 74 65 73 74 20 uts $file {test
c9e0: 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a data on socket}.
c9f0: 09 20 20 20 20 65 78 65 63 20 24 74 63 6c 73 68 . exec $tclsh
ca00: 20 73 63 72 69 70 74 31 20 26 0a 09 20 20 20 20 script1 &..
ca10: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
ca20: 09 7d 0a 09 63 61 74 63 68 20 7b 76 77 61 69 74 .}..catch {vwait
ca30: 20 66 6f 72 65 76 65 72 7d 0a 20 20 20 20 7d 0a forever}. }.
ca40: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
ca50: 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 # Launch the s
ca60: 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 20 61 cript2 process a
ca70: 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 nd connect to it
ca80: 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a . See how long.
ca90: 20 20 20 20 23 20 74 68 65 20 73 6f 63 6b 65 74 # the socket
caa0: 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 stays open..
cab0: 20 65 78 65 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 exec [info name
cac0: 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 20 73 63 ofexecutable] sc
cad0: 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61 66 74 ript2 &.. aft
cae0: 65 72 20 31 30 30 30 20 73 65 74 20 6f 6b 5f 74 er 1000 set ok_t
caf0: 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 20 20 o_proceed 1.
cb00: 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 vwait ok_to_proc
cb10: 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66 20 5b eed.. set f [
cb20: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
cb30: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
cb40: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
cb50: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
cb60: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
cb70: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 39 127.0.0.1 89
cb80: 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 30]. fconfigu
cb90: 72 65 20 24 66 20 2d 62 75 66 66 65 72 69 6e 67 re $f -buffering
cba0: 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 full -blocking
cbb0: 30 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 0. fileevent
cbc0: 24 66 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $f readable [lis
cbd0: 74 20 67 65 74 64 61 74 61 20 24 66 5d 0a 0a 20 t getdata $f]..
cbe0: 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b # If the sock
cbf0: 65 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e et is still open
cc00: 20 61 66 74 65 72 20 35 20 73 65 63 6f 6e 64 73 after 5 seconds
cc10: 2c 20 74 68 65 20 73 63 72 69 70 74 31 20 70 72 , the script1 pr
cc20: 6f 63 65 73 73 0a 20 20 20 20 23 20 6d 75 73 74 ocess. # must
cc30: 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 have inherited
cc40: 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 the accepted soc
cc50: 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ket... set fa
cc60: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
cc70: 20 35 30 30 30 20 73 65 74 20 66 61 69 6c 65 64 5000 set failed
cc80: 20 31 0a 0a 20 20 20 20 70 72 6f 63 20 67 65 74 1.. proc get
cc90: 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a data { file } {.
cca0: 0a 09 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 ..# Read handler
ccb0: 20 6f 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 73 on the client s
ccc0: 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 ocket...global x
ccd0: 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a ..global failed.
cce0: 09 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 .set status [cat
ccf0: 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 ch {read $file}
cd00: 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 data]..if {$stat
cd10: 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 us != 0} {..
cd20: 73 65 74 20 78 20 7b 72 65 61 64 20 66 61 69 6c set x {read fail
cd30: 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 ed, error was $d
cd40: 61 74 61 7d 0a 09 20 20 20 20 63 61 74 63 68 20 ata}.. catch
cd50: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
cd60: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 .} elseif {[stri
cd70: 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 ng compare {} $d
cd80: 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 ata]} {..} elsei
cd90: 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 f {[fblocked $fi
cda0: 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 le]} {..} elseif
cdb0: 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b {[eof $file]} {
cdc0: 0a 09 20 20 20 20 69 66 20 7b 24 66 61 69 6c 65 .. if {$faile
cdd0: 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 d} {...set x {ac
cde0: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 cepted socket wa
cdf0: 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 s inherited}..
ce00: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 } else {...set
ce10: 20 78 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 x {accepted soc
ce20: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
ce30: 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 rited}.. }..
ce40: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
ce50: 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 $file }..} else
ce60: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 {.. set x {i
ce70: 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a mpossible case}.
ce80: 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f . catch { clo
ce90: 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 se $file }..}..r
cea0: 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 eturn. }.
ceb0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 0a 20 20 . vwait x..
cec0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
ced0: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
cee0: 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 20 ile script2.
cef0: 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 set x.} {accepte
cf00: 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 d socket was not
cf10: 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 inherited}..tes
cf20: 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 7b 54 65 t tlsIO-13.1 {Te
cf30: 73 74 69 6e 67 20 75 73 65 20 6f 66 20 73 68 61 sting use of sha
cf40: 72 65 64 20 73 6f 63 6b 65 74 20 62 65 74 77 65 red socket betwe
cf50: 65 6e 20 74 77 6f 20 74 68 72 65 61 64 73 7d 20 en two threads}
cf60: 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 \..{socket testt
cf70: 68 72 65 61 64 7d 20 7b 0a 0a 20 20 20 20 72 65 hread} {.. re
cf80: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
cf90: 20 20 20 20 74 68 72 65 61 64 52 65 61 70 0a 0a threadReap..
cfa0: 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 makeFile {.
cfb0: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
cfc0: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b ire tls..set f [
cfd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
cfe0: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 5d ver accept 8828]
cff0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
d000: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
d010: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
d020: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
d030: 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 echo $s].
d040: 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 fconfigure
d050: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
d060: 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 ne. }..pr
d070: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
d080: 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 global i.
d090: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 set l
d0a0: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
d0b0: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
d0c0: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
d0d0: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
d0e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d0f0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
d100: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
d110: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
d120: 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 } else { ..
d130: 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 incr i.
d140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d150: 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 puts $s $l.
d160: 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 }..}..se
d170: 74 20 69 20 30 0a 09 76 77 61 69 74 20 78 0a 09 t i 0..vwait x..
d180: 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 74 68 72 close $f...# thr
d190: 65 61 64 20 63 6c 65 61 6e 73 20 69 74 73 65 6c ead cleans itsel
d1a0: 66 20 75 70 2e 0a 09 74 65 73 74 74 68 72 65 61 f up...testthrea
d1b0: 64 20 65 78 69 74 0a 20 20 20 20 7d 20 73 63 72 d exit. } scr
d1c0: 69 70 74 0a 20 20 20 20 0a 20 20 20 20 23 20 63 ipt. . # c
d1d0: 72 65 61 74 65 20 61 20 74 68 72 65 61 64 0a 20 reate a thread.
d1e0: 20 20 20 73 65 74 20 73 65 72 76 65 72 74 68 72 set serverthr
d1f0: 65 61 64 20 5b 74 65 73 74 74 68 72 65 61 64 20 ead [testthread
d200: 63 72 65 61 74 65 20 7b 20 73 6f 75 72 63 65 20 create { source
d210: 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 20 20 75 script } ]. u
d220: 70 64 61 74 65 0a 20 20 20 20 0a 20 20 20 20 61 pdate. . a
d230: 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 fter 1000. se
d240: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
d250: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 127.0.0.1 8828]
d260: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
d270: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
d280: 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 20 7b 0a ne.. catch {.
d290: 09 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 .puts $s "hello"
d2a0: 0a 09 67 65 74 73 20 24 73 20 72 65 73 75 6c 74 ..gets $s result
d2b0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
d2c0: 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 0a $s. update..
d2d0: 20 20 20 20 61 66 74 65 72 20 32 30 30 30 0a 20 after 2000.
d2e0: 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c lappend resul
d2f0: 74 20 5b 74 68 72 65 61 64 52 65 61 70 5d 0a 20 t [threadReap].
d300: 20 20 20 0a 20 20 20 20 73 65 74 20 72 65 73 75 . set resu
d310: 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a lt..} {hello 1}.
d320: 0a 23 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b .# cleanup.if {[
d330: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 string match soc
d340: 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 k* $commandSocke
d350: 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 t] == 1} {. pu
d360: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
d370: 74 20 65 78 69 74 0a 20 20 20 66 6c 75 73 68 20 t exit. flush
d380: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d $commandSocket.}
d390: 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 .catch {close $c
d3a0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 ommandSocket}.ca
d3b0: 74 63 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f tch {close $remo
d3c0: 74 65 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 teProcChan}.::tc
d3d0: 6c 74 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 ltest::cleanupTe
d3e0: 73 74 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 sts.flush stdout
d3f0: 0a 72 65 74 75 72 6e 0a 0a .return..