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 37 20 32 30 30 30 2f 30 38 2f 32 33 20 31 .17 2000/08/23 1
0210: 37 3a 31 39 3a 32 36 20 68 6f 62 62 73 20 45 78 7:19:26 hobbs 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 74 65 6e 76 20 72 65 shell% setenv 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 70 72 6f 63 20 64 70 75 ormed...proc dpu
0b00: 74 73 20 7b 6d 73 67 7d 20 7b 20 72 65 74 75 72 ts {msg} { retur
0b10: 6e 20 3b 20 70 75 74 73 20 73 74 64 65 72 72 20 n ; puts stderr
0b20: 24 6d 73 67 20 3b 20 66 6c 75 73 68 20 73 74 64 $msg ; flush std
0b30: 65 72 72 20 7d 0a 0a 69 66 20 7b 5b 6c 73 65 61 err }..if {[lsea
0b40: 72 63 68 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 rch [namespace c
0b50: 68 69 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c 74 65 hildren] ::tclte
0b60: 73 74 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 20 20 st] == -1} {.
0b70: 20 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 package require
0b80: 20 74 63 6c 74 65 73 74 0a 20 20 20 20 6e 61 6d tcltest. nam
0b90: 65 73 70 61 63 65 20 69 6d 70 6f 72 74 20 2d 66 espace import -f
0ba0: 6f 72 63 65 20 3a 3a 74 63 6c 74 65 73 74 3a 3a orce ::tcltest::
0bb0: 2a 0a 7d 0a 0a 23 20 4c 6f 61 64 20 74 68 65 20 *.}..# Load the
0bc0: 74 6c 73 20 70 61 63 6b 61 67 65 0a 0a 70 61 63 tls package..pac
0bd0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
0be0: 20 31 2e 34 0a 0a 73 65 74 20 74 6c 73 53 65 72 1.4..set tlsSer
0bf0: 76 65 72 50 6f 72 74 20 38 30 34 38 0a 0a 23 20 verPort 8048..#
0c00: 53 70 65 63 69 66 79 20 77 68 65 72 65 20 74 68 Specify where th
0c10: 65 20 63 65 72 74 69 66 69 63 61 74 65 73 20 61 e certificates a
0c20: 72 65 0a 0a 73 65 74 20 63 65 72 74 73 44 69 72 re..set certsDir
0c30: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c .[file join [fil
0c40: 65 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 e dirname [info
0c50: 73 63 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a script]] certs].
0c60: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 09 5b set serverCert.[
0c70: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
0c80: 44 69 72 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a Dir server.pem].
0c90: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 09 5b set clientCert.[
0ca0: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
0cb0: 44 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a Dir client.pem].
0cc0: 73 65 74 20 63 61 43 65 72 74 09 5b 66 69 6c 65 set caCert.[file
0cd0: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
0ce0: 63 61 63 65 72 74 2e 70 65 6d 5d 0a 73 65 74 20 cacert.pem].set
0cf0: 73 65 72 76 65 72 4b 65 79 09 5b 66 69 6c 65 20 serverKey.[file
0d00: 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 join $certsDir s
0d10: 6b 65 79 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 key.pem].set cli
0d20: 65 6e 74 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 entKey.[file joi
0d30: 6e 20 24 63 65 72 74 73 44 69 72 20 63 6b 65 79 n $certsDir ckey
0d40: 2e 70 65 6d 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 .pem]..# Some te
0d50: 73 74 73 20 72 65 71 75 69 72 65 20 74 68 65 20 sts require the
0d60: 74 65 73 74 74 68 72 65 61 64 20 61 6e 64 20 65 testthread and e
0d70: 78 65 63 20 63 6f 6d 6d 61 6e 64 73 0a 0a 73 65 xec commands..se
0d80: 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 t ::tcltest::tes
0d90: 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 74 65 73 tConstraints(tes
0da0: 74 74 68 72 65 61 64 29 20 5c 0a 09 5b 65 78 70 tthread) \..[exp
0db0: 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 r {[info command
0dc0: 73 20 74 65 73 74 74 68 72 65 61 64 5d 20 21 3d s testthread] !=
0dd0: 20 7b 7d 7d 5d 0a 73 65 74 20 3a 3a 74 63 6c 74 {}}].set ::tclt
0de0: 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 est::testConstra
0df0: 69 6e 74 73 28 65 78 65 63 29 20 5b 65 78 70 72 ints(exec) [expr
0e00: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 {[info commands
0e10: 20 65 78 65 63 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a exec] != {}}]..
0e20: 23 0a 23 20 49 66 20 72 65 6d 6f 74 65 53 65 72 #.# If remoteSer
0e30: 76 65 72 49 50 20 6f 72 20 72 65 6d 6f 74 65 53 verIP or remoteS
0e40: 65 72 76 65 72 50 6f 72 74 20 61 72 65 20 6e 6f erverPort are no
0e50: 74 20 73 65 74 2c 20 63 68 65 63 6b 20 69 6e 20 t set, check in
0e60: 74 68 65 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 6e the.# environmen
0e70: 74 20 76 61 72 69 61 62 6c 65 73 20 66 6f 72 20 t variables for
0e80: 65 78 74 65 72 6e 61 6c 6c 79 20 73 65 74 20 76 externally set v
0e90: 61 6c 75 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b alues..#..if {![
0ea0: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
0eb0: 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 20 teServerIP]} {.
0ec0: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
0ed0: 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 sts env(remoteSe
0ee0: 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 74 rverIP)]} {..set
0ef0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
0f00: 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 $env(remoteServe
0f10: 72 49 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 rIP). }.}.if
0f20: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 {![info exists r
0f30: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d emoteServerPort]
0f40: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 } {. if {[inf
0f50: 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 65 6d o exists env(rem
0f60: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 5d 7d oteServerPort)]}
0f70: 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 {..set remoteSe
0f80: 72 76 65 72 50 6f 72 74 20 24 65 6e 76 28 72 65 rverPort $env(re
0f90: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 0a moteServerPort).
0fa0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
0fb0: 20 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 if {[info e
0fc0: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
0fd0: 65 72 49 50 5d 7d 20 7b 0a 09 20 20 20 20 73 65 erIP]} {.. se
0fe0: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
0ff0: 72 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 rt $tlsServerPor
1000: 74 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 t. }.
1010: 7d 0a 7d 0a 0a 70 72 6f 63 20 64 6f 5f 68 61 6e }.}..proc do_han
1020: 64 73 68 61 6b 65 20 7b 73 20 7b 74 79 70 65 20 dshake {s {type
1030: 72 65 61 64 61 62 6c 65 7d 20 7b 63 6d 64 20 7b readable} {cmd {
1040: 7d 7d 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 69 }} args} {. i
1050: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
1060: 63 6c 6f 73 65 20 24 73 0a 09 64 70 75 74 73 20 close $s..dputs
1070: 22 68 61 6e 64 73 68 61 6b 65 3a 20 65 6f 66 22 "handshake: eof"
1080: 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 ..set ::do_hands
1090: 68 61 6b 65 20 22 65 6f 66 22 0a 20 20 20 20 7d hake "eof". }
10a0: 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 elseif {[catch
10b0: 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 {tls::handshake
10c0: 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 $s} result]} {..
10d0: 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 # Some errors ar
10e0: 65 20 6e 6f 72 6d 61 6c 2e 0a 09 64 70 75 74 73 e normal...dputs
10f0: 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 24 72 65 "handshake: $re
1100: 73 75 6c 74 22 0a 20 20 20 20 7d 20 65 6c 73 65 sult". } else
1110: 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 if {$result == 1
1120: 7d 20 7b 0a 09 23 20 48 61 6e 64 73 68 61 6b 65 } {..# Handshake
1130: 20 63 6f 6d 70 6c 65 74 65 0a 09 69 66 20 7b 5b complete..if {[
1140: 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 7d 20 llength $args]}
1150: 7b 20 65 76 61 6c 20 66 63 6f 6e 66 69 67 75 72 { eval fconfigur
1160: 65 20 24 73 20 24 61 72 67 73 20 7d 0a 09 69 66 e $s $args }..if
1170: 20 7b 24 63 6d 64 20 3d 3d 20 22 22 7d 20 7b 0a {$cmd == ""} {.
1180: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
1190: 73 20 24 74 79 70 65 20 22 22 0a 09 7d 20 65 6c s $type ""..} el
11a0: 73 65 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 se {.. fileev
11b0: 65 6e 74 20 24 73 20 24 74 79 70 65 20 22 24 63 ent $s $type "$c
11c0: 6d 64 20 24 73 22 0a 09 7d 0a 09 64 70 75 74 73 md $s"..}..dputs
11d0: 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 63 6f 6d "handshake: com
11e0: 70 6c 65 74 65 22 0a 09 73 65 74 20 3a 3a 64 6f plete"..set ::do
11f0: 5f 68 61 6e 64 73 68 61 6b 65 20 22 63 6f 6d 70 _handshake "comp
1200: 6c 65 74 65 22 0a 20 20 20 20 7d 20 65 6c 73 65 lete". } else
1210: 20 7b 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 {..dputs "hands
1220: 68 61 6b 65 3a 20 69 6e 20 70 72 6f 67 72 65 73 hake: in progres
1230: 73 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 s". }.}..#.#
1240: 43 68 65 63 6b 20 69 66 20 77 65 27 72 65 20 73 Check if we're s
1250: 75 70 70 6f 73 65 64 20 74 6f 20 64 6f 20 74 65 upposed to do te
1260: 73 74 73 20 61 67 61 69 6e 73 74 20 74 68 65 20 sts against the
1270: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 0a 23 0a remote server.#.
1280: 0a 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 .set doTestsWith
1290: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 31 0a 69 RemoteServer 1.i
12a0: 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 f {![info exists
12b0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d remoteServerIP]
12c0: 20 26 26 20 28 24 74 63 6c 5f 70 6c 61 74 66 6f && ($tcl_platfo
12d0: 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 21 3d 20 rm(platform) !=
12e0: 22 6d 61 63 69 6e 74 6f 73 68 22 29 7d 20 7b 0a "macintosh")} {.
12f0: 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 set remoteSe
1300: 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 rverIP 127.0.0.1
1310: 0a 7d 0a 69 66 20 7b 28 24 64 6f 54 65 73 74 73 .}.if {($doTests
1320: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
1330: 20 3d 3d 20 31 29 20 26 26 20 28 21 5b 69 6e 66 == 1) && (![inf
1340: 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 o exists remoteS
1350: 65 72 76 65 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 erverPort])} {.
1360: 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 set remoteSer
1370: 76 65 72 50 6f 72 74 20 24 74 6c 73 53 65 72 76 verPort $tlsServ
1380: 65 72 50 6f 72 74 0a 7d 0a 0a 23 20 41 74 74 65 erPort.}..# Atte
1390: 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 mpt to connect t
13a0: 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 o a remote serve
13b0: 72 20 69 66 20 6f 6e 65 20 69 73 20 61 6c 72 65 r if one is alre
13c0: 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 66 20 ady running. If
13d0: 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 6e 6e it.# is not runn
13e0: 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d 65 20 ing or for some
13f0: 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 74 68 65 other reason the
1400: 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 2c 20 connect fails,
1410: 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 74 61 attempt to.# sta
1420: 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 rt the remote se
1430: 72 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f 63 61 rver on the loca
1440: 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 6e 67 l host listening
1450: 20 6f 6e 20 70 6f 72 74 20 38 30 34 38 2e 20 54 on port 8048. T
1460: 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 64 6f his.# is only do
1470: 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 ne on platforms
1480: 74 68 61 74 20 73 75 70 70 6f 72 74 20 65 78 65 that support exe
1490: 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 c (i.e. not on t
14a0: 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 70 6c he Mac). On.# pl
14b0: 61 74 66 6f 72 6d 73 20 74 68 61 74 20 64 6f 20 atforms that do
14c0: 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 not support exec
14d0: 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 , the remote ser
14e0: 76 65 72 20 6d 75 73 74 20 62 65 20 73 74 61 72 ver must be star
14f0: 74 65 64 0a 23 20 62 79 20 74 68 65 20 75 73 65 ted.# by the use
1500: 72 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 r before running
1510: 20 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 65 74 the tests...set
1520: 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 remoteProcChan
1530: 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f "".set commandSo
1540: 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 6f 54 cket "".if {$doT
1550: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1560: 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 74 63 rver} {. catc
1570: 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e h {close $comman
1580: 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 66 20 dSocket}. if
1590: 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d {[catch {set com
15a0: 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a mandSocket [tls:
15b0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
15c0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
15d0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
15e0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
15f0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
1600: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
1610: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 $remoteServerPor
1620: 74 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 69 66 t]}] != 0} {..if
1630: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 {[info commands
1640: 20 65 78 65 63 5d 20 3d 3d 20 22 22 7d 20 7b 0a exec] == ""} {.
1650: 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f 74 . set noRemot
1660: 65 54 65 73 74 52 65 61 73 6f 6e 20 22 63 61 6e eTestReason "can
1670: 27 74 20 65 78 65 63 22 0a 09 20 20 20 20 73 65 't exec".. se
1680: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
1690: 6f 74 65 53 65 72 76 65 72 20 30 0a 09 7d 20 65 oteServer 0..} e
16a0: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 72 lse {.. set r
16b0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 emoteServerIP 12
16c0: 37 2e 30 2e 30 2e 31 0a 09 20 20 20 20 73 65 74 7.0.0.1.. set
16d0: 20 72 65 6d 6f 74 65 46 69 6c 65 20 5b 66 69 6c remoteFile [fil
16e0: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 65 6d e join [pwd] rem
16f0: 6f 74 65 2e 74 63 6c 5d 0a 09 20 20 20 20 69 66 ote.tcl].. if
1700: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 72 65 {[catch {set re
1710: 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 5c 0a 09 moteProcChan \..
1720: 09 20 20 20 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 . [open "|[li
1730: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
1740: 63 6c 74 65 73 74 20 24 72 65 6d 6f 74 65 46 69 cltest $remoteFi
1750: 6c 65 20 5c 0a 09 09 20 20 20 20 2d 73 65 72 76 le \... -serv
1760: 65 72 49 73 53 69 6c 65 6e 74 20 2d 70 6f 72 74 erIsSilent -port
1770: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f $remoteServerPo
1780: 72 74 20 5c 0a 09 09 20 20 20 20 2d 61 64 64 72 rt \... -addr
1790: 65 73 73 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ess $remoteServe
17a0: 72 49 50 5d 22 20 77 2b 5d 7d 20 6d 73 67 5d 20 rIP]" w+]} msg]
17b0: 3d 3d 20 30 7d 20 7b 0a 09 09 61 66 74 65 72 20 == 0} {...after
17c0: 31 30 30 30 0a 09 09 69 66 20 7b 5b 63 61 74 63 1000...if {[catc
17d0: 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f h {set commandSo
17e0: 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 cket [tls::socke
17f0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
1800: 74 20 5c 0a 09 09 09 2d 63 65 72 74 66 69 6c 65 t \....-certfile
1810: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 6b 65 $clientCert -ke
1820: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
1830: 20 5c 0a 09 09 09 24 72 65 6d 6f 74 65 53 65 72 \....$remoteSer
1840: 76 65 72 49 50 20 24 72 65 6d 6f 74 65 53 65 72 verIP $remoteSer
1850: 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 20 3d verPort]} msg] =
1860: 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 66 63 6f = 0} {... fco
1870: 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 nfigure $command
1880: 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 Socket -translat
1890: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
18a0: 69 6e 67 20 6c 69 6e 65 0a 09 09 7d 20 65 6c 73 ing line...} els
18b0: 65 20 7b 0a 09 09 20 20 20 20 73 65 74 20 6e 6f e {... set no
18c0: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
18d0: 20 24 6d 73 67 0a 09 09 20 20 20 20 73 65 74 20 $msg... set
18e0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
18f0: 65 53 65 72 76 65 72 20 30 0a 09 09 7d 0a 09 20 eServer 0...}..
1900: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 } else {...se
1910: 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 t noRemoteTestRe
1920: 61 73 6f 6e 20 22 24 6d 73 67 20 24 3a 3a 74 63 ason "$msg $::tc
1930: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 22 0a ltest::tcltest".
1940: 09 09 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 ..set doTestsWit
1950: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a hRemoteServer 0.
1960: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 20 . }..}. }
1970: 65 6c 73 65 20 7b 0a 09 66 63 6f 6e 66 69 67 75 else {..fconfigu
1980: 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 re $commandSocke
1990: 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 t -translation c
19a0: 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c rlf -buffering l
19b0: 69 6e 65 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 53 ine. }.}..# S
19c0: 6f 6d 65 20 74 65 73 74 73 20 61 72 65 20 72 75 ome tests are ru
19d0: 6e 20 6f 6e 6c 79 20 69 66 20 77 65 20 61 72 65 n only if we are
19e0: 20 64 6f 69 6e 67 20 74 65 73 74 69 6e 67 20 61 doing testing a
19f0: 67 61 69 6e 73 74 20 61 20 72 65 6d 6f 74 65 20 gainst a remote
1a00: 73 65 72 76 65 72 2e 0a 73 65 74 20 3a 3a 74 63 server..set ::tc
1a10: 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 ltest::testConst
1a20: 72 61 69 6e 74 73 28 64 6f 54 65 73 74 73 57 69 raints(doTestsWi
1a30: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 29 20 thRemoteServer)
1a40: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
1a50: 74 65 53 65 72 76 65 72 0a 69 66 20 7b 24 64 6f teServer.if {$do
1a60: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1a70: 65 72 76 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 erver == 0} {.
1a80: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 if {[string fi
1a90: 72 73 74 20 73 20 24 3a 3a 74 63 6c 74 65 73 74 rst s $::tcltest
1aa0: 3a 3a 76 65 72 62 6f 73 65 5d 20 21 3d 20 2d 31 ::verbose] != -1
1ab0: 7d 20 7b 0a 20 20 20 20 09 70 75 74 73 20 22 53 } {. .puts "S
1ac0: 6b 69 70 70 69 6e 67 20 74 65 73 74 73 20 77 69 kipping tests wi
1ad0: 74 68 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 th remote server
1ae0: 2e 20 53 65 65 20 74 65 73 74 73 2f 73 6f 63 6b . See tests/sock
1af0: 65 74 2e 74 65 73 74 20 66 6f 72 22 0a 09 70 75 et.test for"..pu
1b00: 74 73 20 22 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 ts "information
1b10: 6f 6e 20 68 6f 77 20 74 6f 20 72 75 6e 20 72 65 on how to run re
1b20: 6d 6f 74 65 20 73 65 72 76 65 72 2e 22 0a 09 70 mote server."..p
1b30: 75 74 73 20 22 52 65 61 73 6f 6e 20 66 6f 72 20 uts "Reason for
1b40: 6e 6f 74 20 64 6f 69 6e 67 20 72 65 6d 6f 74 65 not doing remote
1b50: 20 74 65 73 74 73 3a 20 24 6e 6f 52 65 6d 6f 74 tests: $noRemot
1b60: 65 54 65 73 74 52 65 61 73 6f 6e 22 0a 20 20 20 eTestReason".
1b70: 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 77 65 20 }.}..#.# If we
1b80: 64 6f 20 74 68 65 20 74 65 73 74 73 2c 20 64 65 do the tests, de
1b90: 66 69 6e 65 20 61 20 63 6f 6d 6d 61 6e 64 20 74 fine a command t
1ba0: 6f 20 73 65 6e 64 20 61 20 63 6f 6d 6d 61 6e 64 o send a command
1bb0: 20 74 6f 20 74 68 65 0a 23 20 72 65 6d 6f 74 65 to the.# remote
1bc0: 20 73 65 72 76 65 72 2e 0a 23 0a 0a 69 66 20 7b server..#..if {
1bd0: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
1be0: 74 65 53 65 72 76 65 72 20 3d 3d 20 31 7d 20 7b teServer == 1} {
1bf0: 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 43 6f . proc sendCo
1c00: 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 67 6c 6f mmand {c} {..glo
1c10: 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 bal commandSocke
1c20: 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 24 63 6f t...if {[eof $co
1c30: 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a mmandSocket]} {.
1c40: 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f . error "remo
1c50: 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 te server disapp
1c60: 65 61 72 65 64 22 0a 09 7d 0a 0a 09 69 66 20 7b eared"..}...if {
1c70: 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f [catch {puts $co
1c80: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 24 63 7d 20 mmandSocket $c}
1c90: 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 msg]} {.. err
1ca0: 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 or "remote serve
1cb0: 72 20 64 69 73 61 70 70 61 65 72 65 64 3a 20 24 r disappaered: $
1cc0: 6d 73 67 22 0a 09 7d 0a 09 69 66 20 7b 5b 63 61 msg"..}..if {[ca
1cd0: 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 tch {puts $comma
1ce0: 6e 64 53 6f 63 6b 65 74 20 22 2d 2d 4d 61 72 6b ndSocket "--Mark
1cf0: 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b er--Marker--Mark
1d00: 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 7b 0a 09 er--"} msg]} {..
1d10: 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 error "remot
1d20: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 e server disappe
1d30: 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 0a ared: $msg"..}..
1d40: 09 73 65 74 20 72 65 73 70 20 22 22 0a 09 77 68 .set resp ""..wh
1d50: 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 20 20 73 ile {1} {.. s
1d60: 65 74 20 6c 69 6e 65 20 5b 67 65 74 73 20 24 63 et line [gets $c
1d70: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 0a 09 20 ommandSocket]..
1d80: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d if {[eof $com
1d90: 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 mandSocket]} {..
1da0: 09 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 .error "remote s
1db0: 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 65 erver disappeare
1dc0: 64 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 d".. }.. i
1dd0: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
1de0: 72 65 20 24 6c 69 6e 65 20 22 2d 2d 4d 61 72 6b re $line "--Mark
1df0: 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b er--Marker--Mark
1e00: 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 er--"] == 0} {..
1e10: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d .if {[string com
1e20: 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 72 65 pare [lindex $re
1e30: 73 70 20 30 5d 20 65 72 72 6f 72 5d 20 3d 3d 20 sp 0] error] ==
1e40: 30 7d 20 7b 0a 09 09 20 20 20 20 65 72 72 6f 72 0} {... error
1e50: 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 [lindex $resp 1
1e60: 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 ]...} else {...
1e70: 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 return [linde
1e80: 78 20 24 72 65 73 70 20 31 5d 0a 09 09 7d 0a 09 x $resp 1]...}..
1e90: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 61 } else {...a
1ea0: 70 70 65 6e 64 20 72 65 73 70 20 24 6c 69 6e 65 ppend resp $line
1eb0: 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a 09 7d 0a "\n".. }..}.
1ec0: 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 6e 64 43 }.. sendC
1ed0: 6f 6d 6d 61 6e 64 20 5b 6c 69 73 74 20 70 72 6f ommand [list pro
1ee0: 63 20 64 70 75 74 73 20 5b 69 6e 66 6f 20 61 72 c dputs [info ar
1ef0: 67 73 20 64 70 75 74 73 5d 20 5b 69 6e 66 6f 20 gs dputs] [info
1f00: 62 6f 64 79 20 64 70 75 74 73 5d 5d 0a 0a 20 20 body dputs]]..
1f10: 20 20 70 72 6f 63 20 73 65 6e 64 43 65 72 74 56 proc sendCertV
1f20: 61 6c 75 65 73 20 7b 7d 20 7b 0a 09 23 20 57 65 alues {} {..# We
1f30: 20 6e 65 65 64 20 74 6f 20 62 65 20 61 62 6c 65 need to be able
1f40: 20 74 6f 20 73 65 6e 64 20 63 65 72 74 69 66 69 to send certifi
1f50: 63 61 74 65 20 76 61 6c 75 65 73 20 74 68 61 74 cate values that
1f60: 20 6e 6f 72 6d 61 6c 69 7a 65 0a 09 23 20 66 69 normalize..# fi
1f70: 6c 65 6e 61 6d 65 73 20 61 63 72 6f 73 73 20 70 lenames across p
1f80: 6c 61 74 66 6f 72 6d 73 0a 09 73 65 6e 64 43 6f latforms..sendCo
1f90: 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 mmand {.. set
1fa0: 20 63 65 72 74 73 44 69 72 09 5b 66 69 6c 65 20 certsDir.[file
1fb0: 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61 join [file dirna
1fc0: 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d me [info script]
1fd0: 5d 20 63 65 72 74 73 5d 0a 09 20 20 20 20 73 65 ] certs].. se
1fe0: 74 20 73 65 72 76 65 72 43 65 72 74 09 5b 66 69 t serverCert.[fi
1ff0: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
2000: 72 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a 09 20 r server.pem]..
2010: 20 20 20 73 65 74 20 63 6c 69 65 6e 74 43 65 72 set clientCer
2020: 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 t.[file join $ce
2030: 72 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 70 65 rtsDir client.pe
2040: 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 61 43 65 m].. set caCe
2050: 72 74 09 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 rt..[file join $
2060: 63 65 72 74 73 44 69 72 20 63 61 63 65 72 74 2e certsDir cacert.
2070: 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 73 65 pem].. set se
2080: 72 76 65 72 4b 65 79 09 5b 66 69 6c 65 20 6a 6f rverKey.[file jo
2090: 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 6b 65 in $certsDir ske
20a0: 79 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 y.pem].. set
20b0: 63 6c 69 65 6e 74 4b 65 79 09 5b 66 69 6c 65 20 clientKey.[file
20c0: 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 join $certsDir c
20d0: 6b 65 79 2e 70 65 6d 5d 0a 09 7d 0a 20 20 20 20 key.pem]..}.
20e0: 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d }.}..test tlsIO-
20f0: 31 2e 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.1 {arg parsing
2100: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2110: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2120: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2130: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2140: 72 76 65 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a rver} msg] $msg.
2150: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2160: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2170: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2180: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 er command ?opti
2190: 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 ons? port"}}..te
21a0: 73 74 20 74 6c 73 49 4f 2d 31 2e 32 20 7b 61 72 st tlsIO-1.2 {ar
21b0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
21c0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
21d0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
21e0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
21f0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f ocket -server fo
2200: 6f 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b o} msg] $msg.} {
2210: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2220: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2230: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2240: 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 command ?options
2250: 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 ? port"}}..test
2260: 74 6c 73 49 4f 2d 31 2e 33 20 7b 61 72 67 20 70 tlsIO-1.3 {arg p
2270: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2280: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2290: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
22a0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
22b0: 65 74 20 2d 6d 79 61 64 64 72 7d 20 6d 73 67 5d et -myaddr} msg]
22c0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
22d0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
22e0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
22f0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
2300: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2310: 73 49 4f 2d 31 2e 34 20 7b 61 72 67 20 70 61 72 sIO-1.4 {arg par
2320: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2330: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2340: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2350: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2360: 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 -myaddr 127.0.0
2370: 2e 31 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 .1} msg] $msg.}
2380: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
2390: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
23a0: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
23b0: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
23c0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 35 20 .test tlsIO-1.5
23d0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
23e0: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
23f0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2400: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2410: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 ::socket -myport
2420: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2430: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2440: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2450: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
2460: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2470: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 est tlsIO-1.6 {a
2480: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2490: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
24a0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
24b0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
24c0: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 socket -myport x
24d0: 78 78 78 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d xxx} msg] $msg.}
24e0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
24f0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2500: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
2510: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
2520: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 37 ..test tlsIO-1.7
2530: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
2540: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
2550: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
2560: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
2570: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 s::socket -mypor
2580: 74 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 t 2522} msg] $ms
2590: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
25a0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
25b0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
25c0: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
25d0: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
25e0: 31 2e 38 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.8 {arg parsing
25f0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2600: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2610: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2620: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 {tls::socket -fr
2630: 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a oboz} msg] $msg.
2640: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2650: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2660: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
2670: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
2680: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2690: 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 9 {arg parsing f
26a0: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
26b0: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
26c0: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
26d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
26e0: 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 er foo -myport 2
26f0: 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 20 24 521 3333} msg] $
2700: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2710: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2720: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
2730: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
2740: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
2750: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 ..test tlsIO-1.1
2760: 30 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 0 {arg parsing f
2770: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2780: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2790: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
27a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 74 20 ls::socket host
27b0: 32 35 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 2528 -junk} msg]
27c0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
27d0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
27e0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
27f0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
2800: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2810: 73 49 4f 2d 31 2e 31 31 20 7b 61 72 67 20 70 61 sIO-1.11 {arg pa
2820: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2830: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2840: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2850: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2860: 74 20 2d 73 65 72 76 65 72 20 63 61 6c 6c 62 61 t -server callba
2870: 63 6b 20 32 35 32 30 20 2d 2d 7d 20 6d 73 67 5d ck 2520 --} msg]
2880: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
2890: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
28a0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
28b0: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
28c0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
28d0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
28e0: 2e 31 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 .12 {arg parsing
28f0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2900: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2910: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2920: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f {tls::socket foo
2930: 20 62 61 64 70 6f 72 74 7d 20 6d 73 67 5d 20 24 badport} msg] $
2940: 6d 73 67 0a 7d 20 7b 31 20 7b 65 78 70 65 63 74 msg.} {1 {expect
2950: 65 64 20 69 6e 74 65 67 65 72 20 62 75 74 20 67 ed integer but g
2960: 6f 74 20 22 62 61 64 70 6f 72 74 22 7d 7d 0a 0a ot "badport"}}..
2970: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 20 7b test tlsIO-2.1 {
2980: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 tcp connection}
2990: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
29a0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
29b0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
29c0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
29d0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 . puts $f {.
29e0: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
29f0: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
2a00: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
2a10: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
2a20: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
2a30: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
2a40: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2a50: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
2a60: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
2a70: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
2a80: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
2a90: 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 y 8828 \]". p
2aa0: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
2ab0: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
2ac0: 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c port} {.. gl
2ad0: 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 obal x.. set
2ae0: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
2af0: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
2b00: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
2b10: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
2b20: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
2b30: 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 se $f..puts $x.
2b40: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2b50: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2b60: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2b70: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2b80: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2b90: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
2ba0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2bb0: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
2bc0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
2bd0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
2be0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
2bf0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 127.0.0.1 8828}
2c00: 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 msg]} {.
2c10: 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 set x $msg.
2c20: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
2c30: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
2c40: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
2c50: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
2c60: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
2c70: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
2c80: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
2c90: 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a ready done {}}..
2ca0: 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 if [info exists
2cb0: 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 72 port] {. incr
2cc0: 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 20 0a port.} else { .
2cd0: 20 20 20 20 73 65 74 20 70 6f 72 74 20 5b 65 78 set port [ex
2ce0: 70 72 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 pr $tlsServerPor
2cf0: 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a t + [pid]%1024].
2d00: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
2d10: 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 2 {tcp connectio
2d20: 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 6f n with client po
2d30: 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 rt specified} {s
2d40: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
2d50: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
2d60: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
2d70: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
2d80: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
2d90: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
2da0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
2db0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
2dc0: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
2dd0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2de0: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2df0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
2e00: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
2e10: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2e20: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
2e30: 76 65 72 4b 65 79 20 38 38 32 39 20 5c 5d 22 0a verKey 8829 \]".
2e40: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
2e50: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
2e60: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
2e70: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
2e80: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
2e90: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
2ea0: 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 20 20 20 ] $port".
2eb0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
2ec0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
2ed0: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
2ee0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
2ef0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
2f00: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
2f10: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2f20: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2f30: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2f40: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2f50: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2f60: 74 73 20 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 ts $f x. glob
2f70: 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 20 7b al port. if {
2f80: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2f90: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 ket -myport $por
2fa0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
2fb0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
2fc0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
2fd0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
2fe0: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 y 127.0.0.1 8829
2ff0: 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 } sock]} {.
3000: 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 09 set x $sock..
3010: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b 74 6c catch {close [tl
3020: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
3030: 30 2e 31 20 38 38 32 39 5d 7d 0a 20 20 20 20 7d 0.1 8829]}. }
3040: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
3050: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
3060: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 ..flush $sock.
3070: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
3080: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
3090: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
30a0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
30b0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 5b 6c 69 . set x.} [li
30c0: 73 74 20 72 65 61 64 79 20 22 68 65 6c 6c 6f 20 st ready "hello
30d0: 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 74 6c $port"]..test tl
30e0: 73 49 4f 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e sIO-2.3 {tcp con
30f0: 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 nection with cli
3100: 65 6e 74 20 69 6e 74 65 72 66 61 63 65 20 73 70 ent interface sp
3110: 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 ecified} {socket
3120: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
3130: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
3140: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3150: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
3160: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
3170: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
3180: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
3190: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
31a0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
31b0: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
31c0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
31d0: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
31e0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
31f0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
3200: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
3210: 79 20 38 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 y 8830 \]". p
3220: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
3230: 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 ccept {sock addr
3240: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
3250: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
3260: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
3270: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 61 64 [gets $sock] $ad
3280: 64 72 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 dr".
3290: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
32a0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
32b0: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
32c0: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
32d0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
32e0: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
32f0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3300: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
3310: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
3320: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
3330: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
3340: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
3350: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
3360: 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 myaddr 127.0.0.1
3370: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
3380: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3390: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
33a0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
33b0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 30 7d 127.0.0.1 8830}
33c0: 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 sock]} {.
33d0: 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 set x $sock.
33e0: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
33f0: 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 puts $sock he
3400: 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 llo..catch {flus
3410: 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 h $sock}.
3420: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
3430: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
3440: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3450: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3460: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b set x.} {ready {
3470: 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d hello 127.0.0.1}
3480: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
3490: 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 4 {tcp connectio
34a0: 6e 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e n with server in
34b0: 74 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 terface specifie
34c0: 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f d} {socket stdio
34d0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
34e0: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
34f0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3500: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3510: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
3520: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
3530: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
3540: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
3550: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3560: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3570: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3580: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
3590: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
35a0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
35b0: 20 24 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 $serverKey -mya
35c0: 64 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 ddr [info hostna
35d0: 6d 65 5d 20 38 38 33 31 20 5c 5d 22 0a 20 20 20 me] 8831 \]".
35e0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
35f0: 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 accept {sock ad
3600: 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 dr port} {.
3610: 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a global x.
3620: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
3630: 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 22 0a "[gets $sock]".
3640: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
3650: 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 e $sock.
3660: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
3670: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
3680: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
3690: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
36a0: 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 se $f. }.
36b0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
36c0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
36d0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
36e0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
36f0: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
3700: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
3710: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
3720: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3730: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3740: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3750: 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f ientKey [info ho
3760: 73 74 6e 61 6d 65 5d 20 38 38 33 31 7d 20 73 6f stname] 8831} so
3770: 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 ck]} {. s
3780: 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d et x $sock. }
3790: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
37a0: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
37b0: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 ..flush $sock.
37c0: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
37d0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
37e0: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
37f0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
3800: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
3810: 61 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 ady hello}..test
3820: 20 74 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 70 20 tlsIO-2.5 {tcp
3830: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
3840: 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 redundant server
3850: 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 port} {socket s
3860: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
3870: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
3880: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
3890: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
38a0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
38b0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
38c0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
38d0: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
38e0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
38f0: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
3900: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
3910: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
3920: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
3930: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
3940: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
3950: 38 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 75 74 8832 \]". put
3960: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
3970: 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 ept {sock addr p
3980: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
3990: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
39a0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
39b0: 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 20 20 ets $sock]".
39c0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
39d0: 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 ock.
39e0: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
39f0: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3a00: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3a10: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3a20: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
3a30: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3a40: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3a50: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3a60: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3a70: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
3a80: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
3a90: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
3aa0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
3ab0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
3ac0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3ad0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
3ae0: 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 32} sock]} {.
3af0: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
3b00: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
3b10: 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b puts $sock
3b20: 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 hello..flush $s
3b30: 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 ock. lapp
3b40: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
3b50: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3b60: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ock. }. cl
3b70: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
3b80: 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d .} {ready hello}
3b90: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 36 20 .test tlsIO-2.6
3ba0: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d {tcp connection}
3bb0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
3bc0: 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 set status ok.
3bd0: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 if {![catch {s
3be0: 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f et sock [tls::so
3bf0: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 cket 127.0.0.1 8
3c00: 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 833]}]} {..if {!
3c10: 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 6f [catch {gets $so
3c20: 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 ck}]} {.. set
3c30: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
3c40: 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 }..close $sock.
3c50: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 }. set sta
3c60: 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 tus.} ok..test t
3c70: 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 68 6f 20 73 lsIO-2.7 {echo s
3c80: 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d erver, one line}
3c90: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
3ca0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
3cb0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
3cc0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
3cd0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
3ce0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
3cf0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
3d00: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
3d10: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
3d20: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
3d30: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
3d40: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
3d50: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
3d60: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
3d70: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
3d80: 73 65 72 76 65 72 4b 65 79 20 38 38 33 34 20 5c serverKey 8834 \
3d90: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
3da0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
3db0: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
3dc0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
3dd0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
3de0: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
3df0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
3e00: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
3e10: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
3e20: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
3e30: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 {s} {.. set
3e40: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
3e50: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
3e60: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
3e70: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
3e80: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
3e90: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
3ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
3eb0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
3ec0: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
3ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ee0: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
3ef0: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 }..}..p
3f00: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3f10: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3f20: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3f30: 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 f..puts done.
3f40: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3f50: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3f60: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
3f70: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
3f80: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
3f90: 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 $f. set s [t
3fa0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
3fb0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3fc0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3fd0: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3fe0: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
3ff0: 31 20 38 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 1 8834]. fcon
4000: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
4010: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
4020: 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 lation lf. pu
4030: 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 ts $s "hello abc
4040: 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 defghijklmnop".
4050: 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 after 1000.
4060: 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 73 set x [gets $s
4070: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
4080: 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 20 24 set y [gets $
4090: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
40a0: 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 0a 7d list $x $y.}
40b0: 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 {{hello abcdefg
40c0: 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d hijklmnop} done}
40d0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 38 ..test tlsIO-2.8
40e0: 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6c {echo server, l
40f0: 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 73 69 oop 50 times, si
4100: 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d ngle connection}
4110: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
4120: 7b 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 {. set f [ope
4130: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
4140: 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 puts $f {. .p
4150: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
4160: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
4170: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
4180: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4190: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
41a0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
41b0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
41c0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
41d0: 65 79 20 38 38 33 35 20 5c 5d 22 0a 20 20 20 20 ey 8835 \]".
41e0: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
41f0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
4200: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
4210: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
4220: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
4230: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 ]. fc
4240: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
4250: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
4260: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
4270: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f {s} {.. glo
4280: 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 bal i.
4290: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
42a0: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
42b0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
42c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42d0: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
42e0: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
42f0: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
4300: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
4310: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 } e
4320: 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 lse { ..
4330: 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 incr i.
4340: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
4350: 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 $l.
4360: 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 }..}..set i 0..
4370: 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 puts ready..set
4380: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
4390: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
43a0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
43b0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
43c0: 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 close $f..puts "
43d0: 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 done $i". }.
43e0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
43f0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
4400: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
4410: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
4420: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
4430: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
4440: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
4450: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
4460: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
4470: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
4480: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
4490: 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 35]. fconfigu
44a0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
44b0: 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 68 20 line. catch
44c0: 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 30 7d {..for {set x 0}
44d0: 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 {$x < 50} {incr
44e0: 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 x} {.. puts
44f0: 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 $s "hello abcdef
4500: 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 ghijklmnop"..
4510: 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 20 20 gets $s..}.
4520: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 }. close $s.
4530: 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 78 20 catch {set x
4540: 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 [gets $f]}. c
4550: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4560: 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 x.} {done 50}..t
4570: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 39 20 7b 73 est tlsIO-2.9 {s
4580: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
4590: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
45a0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
45b0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
45c0: 61 63 63 65 70 74 20 38 38 32 38 5d 0a 20 20 20 accept 8828].
45d0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
45e0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
45f0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
4600: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
4610: 20 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 71 $f {package req
4620: 75 69 72 65 20 74 6c 73 3b 20 74 6c 73 3a 3a 73 uire tls; tls::s
4630: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4640: 63 65 70 74 20 38 38 32 38 7d 0a 20 20 20 20 63 cept 8828}. c
4650: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4660: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
4670: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
4680: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
4690: 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 gets $f.
46a0: 61 66 74 65 72 20 31 30 30 0a 20 20 20 20 73 65 after 100. se
46b0: 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 t x [list [catch
46c0: 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d {close $f} msg]
46d0: 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 24 [string range $
46e0: 6d 73 67 20 30 20 34 33 5d 5d 0a 20 20 20 20 63 msg 0 43]]. c
46f0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
4700: 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 x.} {1 {couldn't
4710: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
4720: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
4730: 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 use}}..test tls
4740: 49 4f 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 20 6f IO-2.10 {close o
4750: 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 70 74 n accept, accept
4760: 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 73 7d ed socket lives}
4770: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
4780: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 set done 0. s
4790: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
47a0: 32 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 20000 "set done
47b0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
47c0: 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 set ss [tls::soc
47d0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
47e0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
47f0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
4800: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
4810: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
4820: 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 8830]. proc a
4830: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
4840: 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 .global ss..clos
4850: 65 20 24 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 e $ss..fileevent
4860: 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 $s readable "re
4870: 61 64 69 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 adit $s"..fconfi
4880: 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 20 6c gure $s -trans l
4890: 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 f. }. proc
48a0: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
48b0: 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 lobal done..gets
48c0: 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 $s..close $s..s
48d0: 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a et done 1. }.
48e0: 20 20 20 20 73 65 74 20 63 73 20 5b 74 6c 73 3a set cs [tls:
48f0: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
4900: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
4910: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
4920: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
4930: 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e tKey [info hostn
4940: 61 6d 65 5d 20 38 38 33 30 5d 0a 20 20 20 20 63 ame] 8830]. c
4950: 6c 6f 73 65 20 24 63 73 0a 0a 20 20 20 20 76 77 lose $cs.. vw
4960: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
4970: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
4980: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 . set done.}
4990: 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 1..test tlsIO-2.
49a0: 31 31 20 7b 64 65 74 65 63 74 69 6e 67 20 6e 65 11 {detecting ne
49b0: 77 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 74 7d w data} {socket}
49c0: 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 {. proc acce
49d0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
49e0: 6f 62 61 6c 20 73 6f 63 6b 0a 09 23 20 77 68 65 obal sock..# whe
49f0: 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 n doing an in-pr
4a00: 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 ocess client/ser
4a10: 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 ver test, both s
4a20: 69 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 ides need..# to
4a30: 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 be non-blocking
4a40: 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 for the TLS hand
4a50: 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b shake. Also mak
4a60: 65 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 e sure..# to ret
4a70: 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 urn the channel
4a80: 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e to line bufferin
4a90: 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 g mode...fconfig
4aa0: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
4ab0: 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 0 -buffering li
4ac0: 6e 65 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 0a ne..set sock $s.
4ad0: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
4ae0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f adable [list do_
4af0: 68 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a 20 20 handshake $s].
4b00: 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 20 5b }.. set s [
4b10: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4b20: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 ver accept \..
4b30: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
4b40: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
4b50: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
4b60: 20 24 73 65 72 76 65 72 4b 65 79 20 38 34 30 30 $serverKey 8400
4b70: 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 20 22 ]. set sock "
4b80: 22 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c ". set s2 [tl
4b90: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
4ba0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
4bb0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4bc0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
4bd0: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
4be0: 20 38 34 30 30 5d 0a 20 20 20 20 23 20 77 68 65 8400]. # whe
4bf0: 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 n doing an in-pr
4c00: 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 ocess client/ser
4c10: 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 ver test, both s
4c20: 69 64 65 73 20 6e 65 65 64 0a 20 20 20 20 23 20 ides need. #
4c30: 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 to be non-blocki
4c40: 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 ng for the TLS h
4c50: 61 6e 64 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d andshake Also m
4c60: 61 6b 65 20 73 75 72 65 20 74 6f 0a 20 20 20 20 ake sure to.
4c70: 23 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 # return the cha
4c80: 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 nnel to line buf
4c90: 66 65 72 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 fering mode (TLS
4ca0: 20 73 65 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e sets it to 'non
4cb0: 65 27 29 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 e').. fconfig
4cc0: 75 72 65 20 24 73 32 20 2d 62 6c 6f 63 6b 69 6e ure $s2 -blockin
4cd0: 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 0 -buffering l
4ce0: 69 6e 65 0a 20 20 20 20 76 77 61 69 74 20 73 6f ine. vwait so
4cf0: 63 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 ck. puts $s2
4d00: 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 one. flush $s
4d10: 32 0a 20 20 20 20 23 20 6e 65 65 64 20 75 70 64 2. # need upd
4d20: 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 ate to complete
4d30: 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 69 6e TLS handshake in
4d40: 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 75 70 64 -process. upd
4d50: 61 74 65 0a 20 20 20 20 61 66 74 65 72 20 35 30 ate. after 50
4d60: 30 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 0. fconfigure
4d70: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
4d80: 20 30 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 0. set resul
4d90: 74 20 61 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d t a:[gets $sock]
4da0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 . lappend res
4db0: 75 6c 74 20 62 3a 5b 67 65 74 73 20 24 73 6f 63 ult b:[gets $soc
4dc0: 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 k]. fconfigur
4dd0: 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e e $sock -blockin
4de0: 67 20 31 0a 20 20 20 20 70 75 74 73 20 24 73 32 g 1. puts $s2
4df0: 20 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 24 two. flush $
4e00: 73 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 s2. fconfigur
4e10: 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e e $sock -blockin
4e20: 67 20 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 g 0. lappend
4e30: 72 65 73 75 6c 74 20 63 3a 5b 67 65 74 73 20 24 result c:[gets $
4e40: 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 sock]. fconfi
4e50: 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 gure $sock -bloc
4e60: 6b 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 king 1. close
4e70: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
4e80: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 s. close $soc
4e90: 6b 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 k. set result
4ea0: 0a 7d 20 7b 61 3a 6f 6e 65 20 62 3a 20 63 3a 74 .} {a:one b: c:t
4eb0: 77 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d wo}..test tlsIO-
4ec0: 32 2e 31 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 2.12 {tcp connec
4ed0: 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 66 69 tion; no certifi
4ee0: 63 61 74 65 73 20 73 70 65 63 69 66 69 65 64 7d cates specified}
4ef0: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 73 74 64 69 \..{socket stdi
4f00: 6f 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 o unixOnly} {.
4f10: 20 20 23 20 54 68 65 72 65 20 69 73 20 61 20 64 # There is a d
4f20: 65 62 75 67 20 61 73 73 65 72 74 69 6f 6e 20 6f ebug assertion o
4f30: 6e 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 n Windows/SSL th
4f40: 61 74 20 63 61 75 73 65 73 20 61 20 63 72 61 73 at causes a cras
4f50: 68 20 77 68 65 6e 20 74 68 65 0a 20 20 20 20 23 h when the. #
4f60: 20 63 65 72 74 69 66 69 63 61 74 65 20 69 73 6e certificate isn
4f70: 27 74 20 73 70 65 63 69 66 69 65 64 2e 0a 20 20 't specified..
4f80: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
4f90: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
4fa0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
4fb0: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
4fc0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
4fd0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
4fe0: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
4ff0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 x timed_out"]..
5000: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
5010: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
5020: 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 t 8828]..proc ac
5030: 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 cept {file addr
5040: 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f port} {.. glo
5050: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
5060: 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 done.
5070: 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d close $file..}
5080: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
5090: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
50a0: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
50b0: 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 e $f..puts $x.
50c0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
50d0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
50e0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
50f0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
5100: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
5110: 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b s $f x. if {[
5120: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
5130: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 et 127.0.0.1 882
5140: 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 8} msg]} {.
5150: 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 set x $msg.
5160: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
5170: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
5180: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
5190: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
51a0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
51b0: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
51c0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
51d0: 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d {ready done {}}
51e0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 31 ..test tlsIO-3.1
51f0: 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 {socket conflic
5200: 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f t} {socket stdio
5210: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
5220: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
5230: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
5240: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
5250: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
5260: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
5270: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
5280: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
5290: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
52a0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
52b0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
52c0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
52d0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 $serverKey 8828
52e0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
52f0: 7b 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 67 {..puts ready..g
5300: 65 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 65 ets stdin..close
5310: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
5320: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
5330: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5340: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5350: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5360: 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 gets $f.
5370: 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 set x [list [cat
5380: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
5390: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
53a0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
53b0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
53c0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
53d0: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
53e0: 61 63 63 65 70 74 20 38 38 32 38 7d 20 6d 73 67 accept 8828} msg
53f0: 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 20 ] \...$msg].
5400: 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 20 puts $f bye.
5410: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5420: 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 x.} {1 {couldn'
5430: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 t open socket: a
5440: 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 ddress already i
5450: 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c n use}}..test tl
5460: 73 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 20 sIO-3.2 {server
5470: 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 with several cli
5480: 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 ents} {socket st
5490: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
54a0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
54b0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
54c0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
54d0: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
54e0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
54f0: 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 et t1 [after 300
5500: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5510: 6f 75 74 22 5d 0a 09 73 65 74 20 74 32 20 5b 61 out"]..set t2 [a
5520: 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 20 fter 31000 "set
5530: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
5540: 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 et t3 [after 320
5550: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5560: 6f 75 74 22 5d 0a 09 73 65 74 20 63 6f 75 6e 74 out"]..set count
5570: 65 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 70 er 0. }. p
5580: 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b uts $f "set s \[
5590: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
55a0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
55b0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
55c0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
55d0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
55e0: 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 rKey 8828 \]".
55f0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
5600: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
5610: 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e {.. fileeven
5620: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
5630: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 ist echo $s]..
5640: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
5650: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
5660: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
5670: 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c } {.. global
5680: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
5690: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
56a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
56b0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 {[eof $s]} {.
56c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c cl
56d0: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
56e0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
56f0: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ne.
5700: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
5710: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
5720: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
5730: 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 }..}..puts rea
5740: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
5750: 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 09 76 er cancel $t1..v
5760: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
5770: 6e 63 65 6c 20 24 74 32 0a 09 76 77 61 69 74 20 ncel $t2..vwait
5780: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
5790: 24 74 33 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 $t3..close $s..p
57a0: 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 uts $x. }.
57b0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
57c0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
57d0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
57e0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
57f0: 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 +]. set x [ge
5800: 74 73 20 24 66 5d 0a 20 20 20 20 73 65 74 20 73 ts $f]. set s
5810: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 1 [tls::socket \
5820: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
5830: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
5840: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
5850: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
5860: 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 \.. 127.0.0.1
5870: 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 8828]. fconf
5880: 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 igure $s1 -buffe
5890: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
58a0: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
58b0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
58c0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
58d0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
58e0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
58f0: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
5900: 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 0.1 8828]. fc
5910: 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 75 onfigure $s2 -bu
5920: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
5930: 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f set s3 [tls::so
5940: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
5950: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
5960: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5970: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
5980: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
5990: 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 .0.0.1 8828].
59a0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 20 fconfigure $s3
59b0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
59c0: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
59d0: 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e } {$i < 100} {in
59e0: 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 cr i} {..puts $s
59f0: 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 1 hello,s1..gets
5a00: 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 $s1..puts $s2 h
5a10: 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 73 ello,s2..gets $s
5a20: 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 2..puts $s3 hell
5a30: 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 o,s3..gets $s3.
5a40: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
5a50: 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 s1. close $s2
5a60: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 . close $s3.
5a70: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
5a80: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
5a90: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
5aa0: 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 {ready done}..te
5ab0: 73 74 20 74 6c 73 49 4f 2d 34 2e 31 20 7b 73 65 st tlsIO-4.1 {se
5ac0: 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 61 rver with severa
5ad0: 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b l clients} {sock
5ae0: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
5af0: 23 20 68 61 76 65 20 73 65 65 6e 20 69 6e 74 65 # have seen inte
5b00: 72 6d 69 74 74 65 6e 74 20 68 61 6e 67 73 20 6f rmittent hangs o
5b10: 6e 20 57 69 6e 64 6f 77 73 0a 20 20 20 20 72 65 n Windows. re
5b20: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
5b30: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
5b40: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
5b50: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
5b60: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
5b70: 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 ..gets stdin.
5b80: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
5b90: 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set s \[tls::soc
5ba0: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
5bb0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
5bc0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5bd0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
5be0: 37 2e 30 2e 30 2e 31 20 38 38 32 38 20 5c 5d 22 7.0.0.1 8828 \]"
5bf0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
5c00: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
5c10: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 uffering line..f
5c20: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
5c30: 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d < 100} {incr i}
5c40: 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 {.. puts $s
5c50: 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 hello.. gets
5c60: 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a $s..}..close $s.
5c70: 09 70 75 74 73 20 62 79 65 0a 09 67 65 74 73 20 .puts bye..gets
5c80: 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 stdin. }.
5c90: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5ca0: 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 p1 [open "|[lis
5cb0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
5cc0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
5cd0: 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 +]. fconfigur
5ce0: 65 20 24 70 31 20 2d 62 75 66 66 65 72 69 6e 67 e $p1 -buffering
5cf0: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 32 line. set p2
5d00: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5d10: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5d20: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5d30: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
5d40: 70 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p2 -buffering li
5d50: 6e 65 0a 20 20 20 20 73 65 74 20 70 33 20 5b 6f ne. set p3 [o
5d60: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
5d70: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
5d80: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
5d90: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 33 20 fconfigure $p3
5da0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
5db0: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
5dc0: 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 {s a p} {..fconf
5dd0: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
5de0: 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 ing line..fileev
5df0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
5e00: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 [list echo $s].
5e10: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 }. proc ec
5e20: 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c ho {s} {..global
5e30: 20 78 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c x. set l
5e40: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 [gets $s].
5e50: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
5e60: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 {. c
5e70: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
5e80: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
5e90: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
5ea0: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
5eb0: 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 7d $s $l. }
5ec0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 . }. set t
5ed0: 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 1 [after 30000 "
5ee0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5ef0: 5d 0a 20 20 20 20 73 65 74 20 74 32 20 5b 61 66 ]. set t2 [af
5f00: 74 65 72 20 33 31 30 30 30 20 22 73 65 74 20 78 ter 31000 "set x
5f10: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
5f20: 20 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 set t3 [after 3
5f30: 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 2000 "set x time
5f40: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 d_out"]. set
5f50: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
5f60: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
5f70: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
5f80: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
5f90: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
5fa0: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
5fb0: 63 63 65 70 74 20 38 38 32 38 5d 0a 20 20 20 20 ccept 8828].
5fc0: 70 75 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 puts $p1 open.
5fd0: 20 20 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a puts $p2 open.
5fe0: 20 20 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 puts $p3 ope
5ff0: 6e 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 n. vwait x.
6000: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 vwait x. vw
6010: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6020: 63 61 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 cancel $t1. a
6030: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a fter cancel $t2.
6040: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
6050: 20 24 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 $t3. close $
6060: 73 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 s. set l "".
6070: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
6080: 73 74 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d st p1 [gets $p1]
6090: 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 $x]. lappend
60a0: 20 6c 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 l [list p2 [get
60b0: 73 20 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c s $p2] $x]. l
60c0: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 append l [list p
60d0: 33 20 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 3 [gets $p3] $x]
60e0: 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 62 79 . puts $p1 by
60f0: 65 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 62 e. puts $p2 b
6100: 79 65 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 ye. puts $p3
6110: 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 bye. close $p
6120: 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 1. close $p2.
6130: 20 20 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 close $p3.
6140: 20 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 set l.} {{p1 b
6150: 79 65 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 ye done} {p2 bye
6160: 20 64 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 done} {p3 bye d
6170: 6f 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 one}}..test tlsI
6180: 4f 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 O-4.2 {byte orde
6190: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
61a0: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
61b0: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
61c0: 20 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 set x ok. i
61d0: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
61e0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 socket -server d
61f0: 6f 64 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 5d odo 0x3000} msg]
6200: 7d 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a } {..set x $msg.
6210: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c } else {..cl
6220: 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ose $msg. }.
6230: 20 20 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 set x.} ok..t
6240: 65 73 74 20 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 est tlsIO-5.1 {b
6250: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
6260: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
6270: 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 rs, htons} \..{s
6280: 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e ocket unixOnly n
6290: 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 otRoot} {. se
62a0: 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 t x {couldn't op
62b0: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
62c0: 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b wner}. if {![
62d0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
62e0: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
62f0: 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 0x1} msg]} {.
6300: 20 20 20 20 20 73 65 74 20 78 20 7b 68 74 6f 6e set x {hton
6310: 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c s problem, shoul
6320: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c d be disallowed,
6330: 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 are you running
6340: 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 as SU?}..close
6350: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
6360: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
6370: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
6380: 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c t owner}.test tl
6390: 73 49 4f 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 sIO-5.2 {byte or
63a0: 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f der problems, so
63b0: 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 cket numbers, ht
63c0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ons} {socket} {.
63d0: 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 set x {could
63e0: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
63f0: 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f port number too
6400: 20 68 69 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 high}. if {!
6410: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
6420: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
6430: 20 30 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 0x10000} msg]}
6440: 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 74 20 72 {..set x {port r
6450: 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 esolution proble
6460: 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 m, should be dis
6470: 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 allowed}..close
6480: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
6490: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
64a0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f open socket: po
64b0: 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 rt number too hi
64c0: 67 68 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 gh}.test tlsIO-5
64d0: 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 .3 {byte order p
64e0: 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 roblems, socket
64f0: 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 numbers, htons}
6500: 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f \..{socket unixO
6510: 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 nly notRoot} {.
6520: 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e set x {couldn
6530: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
6540: 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 not owner}. i
6550: 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a f {![catch {tls:
6560: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6570: 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b dodo 21} msg]} {
6580: 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 ..set x {htons p
6590: 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 roblem, should b
65a0: 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 e disallowed, ar
65b0: 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 e you running as
65c0: 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 SU?}..close $ms
65d0: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
65e0: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
65f0: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
6600: 77 6e 65 72 7d 0a 0a 74 65 73 74 20 74 6c 73 49 wner}..test tlsI
6610: 4f 2d 36 2e 31 20 7b 61 63 63 65 70 74 20 63 61 O-6.1 {accept ca
6620: 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 llback error} {s
6630: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
6640: 20 20 20 23 20 54 68 65 72 65 20 69 73 20 61 20 # There is a
6650: 64 65 62 75 67 20 61 73 73 65 72 74 69 6f 6e 20 debug assertion
6660: 6f 6e 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 on Windows/SSL t
6670: 68 61 74 20 63 61 75 73 65 73 20 61 20 63 72 61 hat causes a cra
6680: 73 68 20 77 68 65 6e 20 74 68 65 0a 20 20 20 20 sh when the.
6690: 23 20 63 65 72 74 69 66 69 63 61 74 65 20 69 73 # certificate is
66a0: 6e 27 74 20 73 70 65 63 69 66 69 65 64 2e 0a 20 n't specified..
66b0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
66c0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
66d0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
66e0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
66f0: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
6700: 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 69 e tls..gets stdi
6710: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 n. }. puts
6720: 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 $f [list tls::s
6730: 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 ocket -cafile $c
6740: 61 43 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 20 aCert 127.0.0.1
6750: 38 38 34 38 5d 0a 20 20 20 20 63 6c 6f 73 65 20 8848]. close
6760: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
6770: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
6780: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
6790: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
67a0: 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 proc bgerror arg
67b0: 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 s {..global x..s
67c0: 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d et x $args. }
67d0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
67e0: 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 {s a p} {expr 1
67f0: 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 20 73 0 / 0}. set s
6800: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
6810: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
6820: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
6830: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
6840: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
6850: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
6860: 34 38 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 48]. puts $f
6870: 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 20 hello. close
6880: 24 66 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 $f. set timer
6890: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
68a0: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
68b0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
68c0: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
68d0: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
68e0: 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 s. rename bge
68f0: 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 rror {}. set
6900: 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 x.} {{divide by
6910: 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 zero}}..test tls
6920: 49 4f 2d 37 2e 31 20 7b 74 65 73 74 69 6e 67 20 IO-7.1 {testing
6930: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
6940: 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 options} {socket
6950: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
6960: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
6970: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
6980: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
6990: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
69a0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
69b0: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b }. puts $f [
69c0: 6c 69 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 list tls::socket
69d0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
69e0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
69f0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
6a00: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
6a10: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
6a20: 20 38 38 32 30 5d 0a 20 20 20 20 70 75 74 73 20 8820]. puts
6a30: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
6a40: 74 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c t args {.. gl
6a50: 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 obal x.. set
6a60: 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 x done..}..puts
6a70: 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 ready..set timer
6a80: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
6a90: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
6aa0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
6ab0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
6ac0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
6ad0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
6ae0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
6af0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
6b00: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
6b10: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 ts $f. set s
6b20: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
6b30: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
6b40: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
6b50: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
6b60: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
6b70: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
6b80: 38 32 30 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 820]. set p [
6b90: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 fconfigure $s -p
6ba0: 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f eername]. clo
6bb0: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
6bc0: 24 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a $f. set l "".
6bd0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 lappend l [s
6be0: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c tring compare [l
6bf0: 69 6e 64 65 78 20 24 70 20 30 5d 20 31 32 37 2e index $p 0] 127.
6c00: 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 0.0.1]. lappe
6c10: 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d nd l [string com
6c20: 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 pare [lindex $p
6c30: 32 5d 20 38 38 32 30 5d 0a 20 20 20 20 6c 61 70 2] 8820]. lap
6c40: 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 pend l [llength
6c50: 24 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a 0a 74 $p].} {0 0 3}..t
6c60: 65 73 74 20 74 6c 73 49 4f 2d 37 2e 32 20 7b 74 est tlsIO-7.2 {t
6c70: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
6c80: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
6c90: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
6ca0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
6cb0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
6cc0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
6cd0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
6ce0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
6cf0: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
6d00: 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b ts $f "tls::sock
6d10: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
6d20: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
6d30: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
6d40: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
6d50: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 31 $serverKey 8821
6d60: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
6d70: 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 .proc accept arg
6d80: 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 s {.. global
6d90: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
6da0: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
6db0: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
6dc0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
6dd0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 timed_out"]..vwa
6de0: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
6df0: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a el $timer. }.
6e00: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
6e10: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
6e20: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
6e30: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
6e40: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
6e50: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6e60: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
6e70: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
6e80: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6e90: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
6ea0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
6eb0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 31 5d 0a 127.0.0.1 8821].
6ec0: 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 set p [fconf
6ed0: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
6ee0: 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 me]. close $s
6ef0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
6f00: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
6f10: 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 append l [llengt
6f20: 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e h $p]. lappen
6f30: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 d l [lindex $p 0
6f40: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
6f50: 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20 5b 6c [string equal [l
6f60: 69 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 31 index $p 2] 8821
6f70: 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 ].} {3 127.0.0.1
6f80: 20 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 0}..test tlsIO-
6f90: 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 7.3 {testing soc
6fa0: 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 ket specific opt
6fb0: 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b ions} {socket} {
6fc0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6fd0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
6fe0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
6ff0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7000: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
7010: 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 rKey \. .-ser
7020: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 32 5d ver accept 8822]
7030: 0a 20 20 20 20 73 65 74 20 6c 20 5b 66 63 6f 6e . set l [fcon
7040: 66 69 67 75 72 65 20 24 73 5d 0a 20 20 20 20 63 figure $s]. c
7050: 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 lose $s. upda
7060: 74 65 0a 20 20 20 20 6c 6c 65 6e 67 74 68 20 24 te. llength $
7070: 6c 0a 7d 20 31 32 0a 0a 23 20 62 75 67 20 72 65 l.} 12..# bug re
7080: 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 port #5812 fconf
7090: 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 igure doesn't re
70a0: 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 turn value for '
70b0: 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 -sockname'..test
70c0: 20 74 6c 73 49 4f 2d 37 2e 34 20 7b 74 65 73 74 tlsIO-7.4 {test
70d0: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
70e0: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
70f0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
7100: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
7110: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
7120: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
7130: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7140: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 $serverKey \.
7150: 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 .-server accep
7160: 74 20 38 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 t 8823]. proc
7170: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
7180: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 {..global x..set
7190: 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 x [fconfigure $
71a0: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c s -sockname]..cl
71b0: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
71c0: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
71d0: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
71e0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
71f0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7200: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
7210: 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 y \. .[info h
7220: 6f 73 74 6e 61 6d 65 5d 20 38 38 32 33 5d 0a 20 ostname] 8823].
7230: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
7240: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
7250: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
7260: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
7270: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
7280: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
7290: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
72a0: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
72b0: 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 pend l [lindex $
72c0: 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 x 2] [llength $x
72d0: 5d 0a 7d 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 ].} {8823 3}..#
72e0: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
72f0: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
7300: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
7310: 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 for '-sockname'
7320: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 ..test tlsIO-7.5
7330: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
7340: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
7350: 73 7d 20 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f s} {socket unixO
7360: 72 50 63 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 rPc} {. set s
7370: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
7380: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
7390: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
73a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
73b0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
73c0: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
73d0: 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 cept 8829]. p
73e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
73f0: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 p} {..global x..
7400: 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 set x [fconfigur
7410: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
7420: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
7430: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
7440: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
7450: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
7460: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7470: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
7480: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
7490: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 0a 127.0.0.1 8829].
74a0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
74b0: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
74c0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
74d0: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 vwait x. af
74e0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
74f0: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
7500: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
7510: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
7520: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
7530: 24 78 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 $x 0] [lindex $x
7540: 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 2] [llength $x]
7550: 0a 7d 20 7b 31 32 37 2e 30 2e 30 2e 31 20 38 38 .} {127.0.0.1 88
7560: 32 39 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 29 3}..test tlsI
7570: 4f 2d 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d O-8.1 {testing -
7580: 61 73 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f async flag on so
7590: 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 ckets} {socket}
75a0: 7b 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 {. # NOTE: Th
75b0: 69 73 20 74 65 73 74 20 6d 61 79 20 66 61 69 6c is test may fail
75c0: 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 on some Solaris
75d0: 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 0a 20 20 2.4 systems..
75e0: 20 20 23 20 53 65 65 20 6e 6f 74 65 73 20 69 6e # See notes in
75f0: 20 54 63 6c 27 73 20 73 6f 63 6b 65 74 2e 74 65 Tcl's socket.te
7600: 73 74 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 st.. set s [t
7610: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
7620: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
7630: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
7640: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7650: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
7660: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
7670: 74 20 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 t 8830]. proc
7680: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
7690: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 23 20 77 {..global x..# w
76a0: 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d hen doing an in-
76b0: 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 process client/s
76c0: 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 erver test, both
76d0: 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 20 74 sides need..# t
76e0: 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e o be non-blockin
76f0: 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 g for the TLS ha
7700: 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d ndshake. Also m
7710: 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f 20 72 ake sure..# to r
7720: 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 eturn the channe
7730: 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 l to line buffer
7740: 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 ing mode...fconf
7750: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
7760: 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 ng 0 -buffering
7770: 6c 69 6e 65 0a 09 70 75 74 73 20 24 73 20 62 79 line..puts $s by
7780: 65 0a 09 23 20 4f 6e 6c 79 20 4f 70 65 6e 53 53 e..# Only OpenSS
7790: 4c 20 30 2e 39 2e 35 61 20 6f 6e 20 57 69 6e 64 L 0.9.5a on Wind
77a0: 6f 77 73 20 73 65 65 6d 73 20 74 6f 20 6e 65 65 ows seems to nee
77b0: 64 20 74 68 65 20 61 66 74 65 72 20 28 64 65 6c d the after (del
77c0: 61 79 65 64 29 0a 09 23 20 63 6c 6f 73 65 2c 20 ayed)..# close,
77d0: 62 75 74 20 69 74 20 77 6f 72 6b 73 20 6a 75 73 but it works jus
77e0: 74 20 74 68 65 20 73 61 6d 65 20 66 6f 72 20 61 t the same for a
77f0: 6c 6c 20 6f 74 68 65 72 73 2e 20 2d 68 6f 62 62 ll others. -hobb
7800: 73 0a 09 61 66 74 65 72 20 35 30 30 20 63 6c 6f s..after 500 clo
7810: 73 65 20 24 73 0a 09 73 65 74 20 78 20 64 6f 6e se $s..set x don
7820: 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 e. }. set
7830: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
7840: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
7850: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
7860: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7870: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
7880: 20 5c 0a 09 20 20 20 20 2d 61 73 79 6e 63 20 5b \.. -async [
7890: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 info hostname] 8
78a0: 38 33 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 830]. # when
78b0: 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 doing an in-proc
78c0: 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 ess client/serve
78d0: 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 r test, both sid
78e0: 65 73 20 6e 65 65 64 0a 20 20 20 20 23 20 74 6f es need. # to
78f0: 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 be non-blocking
7900: 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e for the TLS han
7910: 64 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b dshake Also mak
7920: 65 20 73 75 72 65 20 74 6f 0a 20 20 20 20 23 20 e sure to. #
7930: 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e return the chann
7940: 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 el to line buffe
7950: 72 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 ring mode (TLS s
7960: 65 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 ets it to 'none'
7970: 29 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ).. fconfigur
7980: 65 20 24 73 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 e $s1 -blocking
7990: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
79a0: 65 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 e. vwait x.
79b0: 20 20 23 20 54 4c 53 20 68 61 6e 64 73 68 61 6b # TLS handshak
79c0: 69 6e 67 20 6e 65 65 64 73 20 6f 6e 65 20 62 79 ing needs one by
79d0: 74 65 20 66 72 6f 6d 20 74 68 65 20 63 6c 69 65 te from the clie
79e0: 6e 74 2e 2e 2e 0a 20 20 20 20 70 75 74 73 20 24 nt.... puts $
79f0: 73 31 20 61 0a 20 20 20 20 23 20 6e 65 65 64 20 s1 a. # need
7a00: 75 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 update to comple
7a10: 74 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 te TLS handshake
7a20: 20 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 in-process.
7a30: 75 70 64 61 74 65 0a 20 20 20 20 73 65 74 20 7a update. set z
7a40: 20 5b 67 65 74 73 20 24 73 31 5d 0a 20 20 20 20 [gets $s1].
7a50: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
7a60: 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 7a se $s1. set z
7a70: 0a 7d 20 62 79 65 0a 0a 74 65 73 74 20 74 6c 73 .} bye..test tls
7a80: 49 4f 2d 39 2e 31 20 7b 74 65 73 74 69 6e 67 20 IO-9.1 {testing
7a90: 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d spurious events}
7aa0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
7ab0: 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 set len 0. se
7ac0: 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 t spurious 0.
7ad0: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
7ae0: 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 proc readlittle
7af0: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 {s} {..global sp
7b00: 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a urious done len.
7b10: 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 .set l [read $s
7b20: 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 1]..if {[string
7b30: 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d length $l] == 0}
7b40: 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f {.. if {![eo
7b50: 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 f $s]} {...incr
7b60: 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 spurious.. }
7b70: 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 else {...close $
7b80: 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 s...set done 1..
7b90: 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a }..} else {.
7ba0: 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 . incr len [s
7bb0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
7bc0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ..}. }. pr
7bd0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
7be0: 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 } {..fconfigure
7bf0: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 $s -blocking 0..
7c00: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
7c10: 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 dable [list do_h
7c20: 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 andshake $s read
7c30: 61 62 6c 65 20 72 65 61 64 6c 69 74 74 6c 65 20 able readlittle
7c40: 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6e \...-buffering n
7c50: 6f 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 one]. }. s
7c60: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
7c70: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
7c80: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
7c90: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7ca0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
7cb0: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
7cc0: 72 20 61 63 63 65 70 74 20 38 38 33 31 5d 0a 20 r accept 8831].
7cd0: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
7ce0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
7cf0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
7d00: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
7d10: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
7d20: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 entKey \.. [i
7d30: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 nfo hostname] 88
7d40: 33 31 5d 0a 20 20 20 20 23 20 54 68 69 73 20 64 31]. # This d
7d50: 69 66 66 65 72 73 20 66 72 6f 6d 20 73 6f 63 6b iffers from sock
7d60: 65 74 2d 39 2e 31 20 69 6e 20 74 68 61 74 20 62 et-9.1 in that b
7d70: 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 20 74 oth sides need t
7d80: 6f 20 62 65 0a 20 20 20 20 23 20 6e 6f 6e 2d 62 o be. # non-b
7d90: 6c 6f 63 6b 69 6e 67 20 62 65 63 61 75 73 65 20 locking because
7da0: 6f 66 20 54 4c 53 27 20 72 65 71 75 69 72 65 64 of TLS' required
7db0: 20 68 61 6e 64 73 68 61 6b 65 0a 20 20 20 20 66 handshake. f
7dc0: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
7dd0: 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 74 ocking 0. put
7de0: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 s -nonewline $c
7df0: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 0123456789012345
7e00: 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 6789012345678901
7e10: 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 2345678901234567
7e20: 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 89. close $c.
7e30: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
7e40: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
7e50: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
7e60: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
7e70: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
7e80: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
7e90: 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 73 e $s. list $s
7ea0: 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b purious $len.} {
7eb0: 30 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 0 50}..test tlsI
7ec0: 4f 2d 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 61 O-9.2 {testing a
7ed0: 73 79 6e 63 20 77 72 69 74 65 2c 20 66 69 6c 65 sync write, file
7ee0: 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f 6e events, flush on
7ef0: 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 74 7d close} {socket}
7f00: 20 7b 0a 20 20 20 20 73 65 74 20 66 69 72 73 74 {. set first
7f10: 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 block [string re
7f20: 70 65 61 74 20 61 20 33 31 5d 0a 20 20 20 20 73 peat a 31]. s
7f30: 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b et secondblock [
7f40: 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 62 20 string repeat b
7f50: 36 35 35 33 35 5d 0a 20 20 20 20 70 72 6f 63 20 65535]. proc
7f60: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
7f70: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
7f80: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c -blocking 0..fil
7f90: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
7fa0: 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 le [list do_hand
7fb0: 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 62 6c shake $s readabl
7fc0: 65 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 09 2d e readable \...-
7fd0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d translation lf -
7fe0: 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 buffersize 16384
7ff0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
8000: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 ]. }. proc
8010: 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a readable {s} {.
8020: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d .set l [gets $s]
8030: 0a 09 64 70 75 74 73 20 22 67 6f 74 20 5c 22 5b ..dputs "got \"[
8040: 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 string replace $
8050: 6c 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c l 10 end-3 ...]\
8060: 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c " \...([string l
8070: 65 6e 67 74 68 20 24 6c 5d 29 20 66 72 6f 6d 20 ength $l]) from
8080: 24 73 22 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 $s"..fileevent $
8090: 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 61 s readable {}..a
80a0: 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e fter 1000 respon
80b0: 64 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 d $s. }. p
80c0: 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 roc respond {s}
80d0: 7b 0a 09 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 {..global firstb
80e0: 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 65 6e lock..dputs "sen
80f0: 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 6c d \"[string repl
8100: 61 63 65 20 24 66 69 72 73 74 62 6c 6f 63 6b 20 ace $firstblock
8110: 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 10 end-3 ...]\"
8120: 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e \...([string len
8130: 67 74 68 20 24 66 69 72 73 74 62 6c 6f 63 6b 5d gth $firstblock]
8140: 29 20 64 6f 77 6e 20 24 73 22 0a 09 70 75 74 73 ) down $s"..puts
8150: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
8160: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 74 65 firstblock..afte
8170: 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 r 1000 writedata
8180: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s. }. pr
8190: 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d oc writedata {s}
81a0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 6f 6e {..global secon
81b0: 64 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 dblock..dputs "s
81c0: 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 end \"[string re
81d0: 70 6c 61 63 65 20 24 73 65 63 6f 6e 64 62 6c 6f place $secondblo
81e0: 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d ck 10 end-3 ...]
81f0: 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 \" \...([string
8200: 6c 65 6e 67 74 68 20 24 73 65 63 6f 6e 64 62 6c length $secondbl
8210: 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 0a 09 ock]) down $s"..
8220: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
8230: 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a $s $secondblock.
8240: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
8250: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
8260: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
8270: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
8280: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
8290: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
82a0: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
82b0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
82c0: 33 32 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 32]. set c [t
82d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
82e0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
82f0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8300: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8310: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8320: 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d [info hostnam
8330: 65 5d 20 38 38 33 32 5d 0a 20 20 20 20 66 63 6f e] 8832]. fco
8340: 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 nfigure $c -bloc
8350: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 king 0 -trans lf
8360: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
8370: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 . set count 0
8380: 0a 20 20 20 20 70 75 74 73 20 24 63 20 68 65 6c . puts $c hel
8390: 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 lo. proc read
83a0: 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c it {s} {..global
83b0: 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 count done..set
83c0: 20 64 61 74 61 20 5b 72 65 61 64 20 24 73 5d 0a data [read $s].
83d0: 09 64 70 75 74 73 20 22 72 65 61 64 20 5c 22 5b .dputs "read \"[
83e0: 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 string replace $
83f0: 64 61 74 61 20 31 30 20 65 6e 64 2d 33 20 2e 2e data 10 end-3 ..
8400: 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e .]\" \...([strin
8410: 67 20 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 29 g length $data])
8420: 20 66 72 6f 6d 20 24 73 22 0a 09 69 6e 63 72 20 from $s"..incr
8430: 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 count [string le
8440: 6e 67 74 68 20 24 64 61 74 61 5d 0a 09 69 66 20 ngth $data]..if
8450: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
8460: 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 close $s..
8470: 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 set done 1..}.
8480: 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e }. fileeven
8490: 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 72 t $c readable "r
84a0: 65 61 64 69 74 20 24 63 22 0a 20 20 20 20 73 65 eadit $c". se
84b0: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 t done 0. set
84c0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
84d0: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
84e0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
84f0: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
8500: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
8510: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
8520: 20 20 6c 69 73 74 20 24 63 6f 75 6e 74 20 24 64 list $count $d
8530: 6f 6e 65 0a 7d 20 7b 36 35 35 36 36 20 31 7d 0a one.} {65566 1}.
8540: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 33 20 .test tlsIO-9.3
8550: 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 {testing EOF sti
8560: 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c ckyness} {unexpl
8570: 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 ainedFailure soc
8580: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 ket} {. # HOB
8590: 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 BS: never worked
85a0: 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 70 correctly. p
85b0: 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 roc count_to_eof
85c0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
85d0: 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a ount done timer.
85e0: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d .set l [gets $s]
85f0: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
8600: 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e {.. incr coun
8610: 74 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e t.. if {$coun
8620: 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 t > 9} {...close
8630: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 $s...set done t
8640: 72 75 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 rue...set count
8650: 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a {eof is sticky}.
8660: 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
8670: 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a timer.. }..}.
8680: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 }. proc t
8690: 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 imerproc {} {..g
86a0: 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 lobal done count
86b0: 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 75 c..set done tru
86c0: 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 e..set count {ti
86d0: 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f mer went off, eo
86e0: 66 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d f is not sticky}
86f0: 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d ..close $c. }
8700: 09 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 .. set count
8710: 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 66 0. set done f
8720: 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 72 alse. proc wr
8730: 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b ite_then_close {
8740: 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 79 s} {..puts $s by
8750: 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 e..close $s.
8760: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 }. proc accep
8770: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f t {s a p} {..fco
8780: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
8790: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e king 0 -bufferin
87a0: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
87b0: 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e ion lf..fileeven
87c0: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 5b 6c t $s writable [l
87d0: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
87e0: 20 24 73 20 77 72 69 74 61 62 6c 65 20 77 72 69 $s writable wri
87f0: 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 5c 0a te_then_close \.
8800: 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e ..-buffering lin
8810: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c e -translation l
8820: 66 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 f]. }. set
8830: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
8840: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
8850: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
8860: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8870: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
8880: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
8890: 61 63 63 65 70 74 20 38 38 33 33 5d 0a 20 20 20 accept 8833].
88a0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
88b0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
88c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
88d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
88e0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
88f0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 tKey \.. [inf
8900: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 33 o hostname] 8833
8910: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
8920: 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $c -blocking 0
8930: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
8940: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a -translation lf.
8950: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
8960: 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 readable "count
8970: 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 _to_eof $c".
8980: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
8990: 20 32 30 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 2000 timerproc]
89a0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
89b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
89c0: 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f set count.} {eo
89d0: 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 f is sticky}..re
89e0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
89f0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 30 2e 31 .test tlsIO-10.1
8a00: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
8a10: 20 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b accept callback
8a20: 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d error handling}
8a30: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
8a40: 73 65 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 set goterror 0.
8a50: 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 proc bgerror
8a60: 61 72 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 args {global got
8a70: 65 72 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 error; set goter
8a80: 72 6f 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 ror 1}. set s
8a90: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
8aa0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 73 afile $caCert -s
8ab0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 39 erver accept 889
8ac0: 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 8]. proc acce
8ad0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 pt {s a p} {clos
8ae0: 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a 20 20 20 e $s; error}.
8af0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
8b00: 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ket -cafile $caC
8b10: 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 ert 127.0.0.1 88
8b20: 39 38 5d 0a 20 20 20 20 76 77 61 69 74 20 67 6f 98]. vwait go
8b30: 74 65 72 72 6f 72 0a 20 20 20 20 63 6c 6f 73 65 terror. close
8b40: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 $s. close $c
8b50: 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f . set goterro
8b60: 72 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 r.} 1..test tlsI
8b70: 4f 2d 31 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e O-11.1 {tcp conn
8b80: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 ection} {socket
8b90: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
8ba0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
8bb0: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
8bc0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
8bd0: 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 31 5f 74 .set socket9_1_t
8be0: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
8bf0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
8c00: 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 accept \...-cert
8c10: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
8c20: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8c30: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
8c40: 72 4b 65 79 20 38 38 33 34 5d 0a 09 70 72 6f 63 rKey 8834]..proc
8c50: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
8c60: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 {.. tls::hand
8c70: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 shake $s.. pu
8c80: 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 ts $s done..
8c90: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
8ca0: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
8cb0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
8cc0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
8cd0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
8ce0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
8cf0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
8d00: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
8d10: 20 38 38 33 34 5d 0a 20 20 20 20 73 65 74 20 72 8834]. set r
8d20: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
8d30: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 lose $s. send
8d40: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
8d50: 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 socket9_1_test_s
8d60: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 72 erver}. set r
8d70: 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 74 20 74 6c .} done..test tl
8d80: 73 49 4f 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 sIO-11.2 {client
8d90: 20 73 70 65 63 69 66 69 65 73 20 69 74 73 20 70 specifies its p
8da0: 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ort} {socket doT
8db0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
8dc0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 69 66 20 7b rver} {. if {
8dd0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 [info exists por
8de0: 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 6f 72 74 t]} {..incr port
8df0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
8e00: 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 24 74 et port [expr $t
8e10: 6c 73 53 65 72 76 65 72 50 6f 72 74 20 2b 20 5b lsServerPort + [
8e20: 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 20 7d pid]%1024]. }
8e30: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
8e40: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
8e50: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
8e60: 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_2_test_server
8e70: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
8e80: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
8e90: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
8ea0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
8eb0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
8ec0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 5d $serverKey 8835]
8ed0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
8ee0: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
8ef0: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
8f00: 20 20 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 puts $s $p..
8f10: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
8f20: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
8f30: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
8f40: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
8f50: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
8f60: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8f70: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
8f80: 09 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f . -myport $po
8f90: 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 rt $remoteServer
8fa0: 49 50 20 38 38 33 35 5d 0a 20 20 20 20 73 65 74 IP 8835]. set
8fb0: 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 r [gets $s].
8fc0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
8fd0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
8fe0: 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 $socket9_2_test
8ff0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 _server}. if
9000: 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a {$r == $port} {.
9010: 09 73 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 .set result ok.
9020: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
9030: 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 result broken.
9040: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 }. set res
9050: 75 6c 74 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 ult.} ok..test t
9060: 6c 73 49 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e lsIO-11.3 {tryin
9070: 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f g to connect, no
9080: 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 server} {socket
9090: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
90a0: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
90b0: 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 set status ok.
90c0: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 if {![catch {s
90d0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
90e0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
90f0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
9100: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9110: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
9120: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
9130: 65 53 65 72 76 65 72 49 70 20 38 38 33 36 5d 7d eServerIp 8836]}
9140: 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 ]} {..if {![catc
9150: 68 20 7b 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a h {gets $s}]} {.
9160: 09 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 . set status
9170: 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 broken..}..close
9180: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
9190: 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 t status.} ok..t
91a0: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b est tlsIO-11.4 {
91b0: 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 remote echo, one
91c0: 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 line} {socket d
91d0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
91e0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
91f0: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
9200: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
9210: 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 set socket10_6_t
9220: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
9230: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
9240: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
9250: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9260: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
9270: 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 erKey \...-serve
9280: 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 r accept 8836]..
9290: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
92a0: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
92b0: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
92c0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
92d0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
92e0: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
92f0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
9300: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
9310: 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 lation crlf..}..
9320: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
9330: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
9340: 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 $s].. if {[e
9350: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 of $s]} {...clos
9360: 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 e $s.. } else
9370: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a {...puts $s $l.
9380: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
9390: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
93a0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
93b0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
93c0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
93d0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
93e0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
93f0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
9400: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
9410: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
9420: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
9430: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 ing line. put
9440: 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 s $f hello. s
9450: 65 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 et r [gets $f].
9460: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
9470: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
9480: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 se $socket10_6_t
9490: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
94a0: 73 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 set r.} hello..t
94b0: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b est tlsIO-11.5 {
94c0: 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 remote echo, 50
94d0: 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 lines} {socket d
94e0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
94f0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
9500: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
9510: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
9520: 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 set socket10_7_t
9530: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
9540: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
9550: 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 accept \...-cert
9560: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
9570: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9580: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
9590: 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 rKey 8836]..proc
95a0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
95b0: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 {.. tls::hand
95c0: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 shake $s.. fi
95d0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
95e0: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
95f0: 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 s].. fconfigu
9600: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
9610: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
9620: 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 on crlf..}..proc
9630: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
9640: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
9650: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
9660: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
9670: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
9680: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 .puts $s $l..
9690: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
96a0: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
96b0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
96c0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
96d0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
96e0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
96f0: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
9700: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
9710: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9720: 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $f -translation
9730: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
9740: 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 line. for {se
9750: 74 20 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c t cnt 0} {$cnt <
9760: 20 35 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 50} {incr cnt}
9770: 7b 0a 09 70 75 74 73 20 24 66 20 22 68 65 6c 6c {..puts $f "hell
9780: 6f 2c 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 o, $cnt"..if {[s
9790: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 tring compare [g
97a0: 65 74 73 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 ets $f] "hello,
97b0: 24 63 6e 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 $cnt"] != 0} {..
97c0: 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 break..}.
97d0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
97e0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
97f0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
9800: 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _7_test_server}.
9810: 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 set cnt.} 50
9820: 0a 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f ..# Macintosh so
9830: 63 6b 65 74 73 20 63 61 6e 20 68 61 76 65 20 6d ckets can have m
9840: 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 ore than one ser
9850: 76 65 72 20 70 65 72 20 70 6f 72 74 0a 69 66 20 ver per port.if
9860: 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 {$tcl_platform(p
9870: 6c 61 74 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 latform) == "mac
9880: 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 intosh"} {. s
9890: 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c et conflictResul
98a0: 74 20 7b 30 20 38 38 33 36 7d 0a 7d 20 65 6c 73 t {0 8836}.} els
98b0: 65 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 e {. set conf
98c0: 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 lictResult {1 {c
98d0: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
98e0: 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 ket: address alr
98f0: 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a eady in use}}.}.
9900: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 .test tlsIO-11.6
9910: 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 {socket conflic
9920: 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 t} {socket doTes
9930: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9940: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 31 er} {. set s1
9950: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9960: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9970: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
9980: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9990: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
99a0: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
99b0: 63 65 70 74 20 38 38 33 36 5d 0a 20 20 20 20 69 cept 8836]. i
99c0: 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 73 f {[catch {set s
99d0: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 2 [tls::socket \
99e0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
99f0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
9a00: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9a10: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
9a20: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
9a30: 63 63 65 70 74 20 38 38 33 36 5d 7d 20 6d 73 67 ccept 8836]} msg
9a40: 5d 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 ]} {..set result
9a50: 20 5b 6c 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 [list 1 $msg].
9a60: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
9a70: 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 result [list 0
9a80: 5b 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 [lindex [fconfig
9a90: 75 72 65 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d ure $s2 -socknam
9aa0: 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 e] 2]]..close $s
9ab0: 32 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 2. }. clos
9ac0: 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 72 65 e $s1. set re
9ad0: 73 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 sult.} $conflict
9ae0: 52 65 73 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 Result..test tls
9af0: 49 4f 2d 31 31 2e 37 20 7b 73 65 72 76 65 72 20 IO-11.7 {server
9b00: 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 with several cli
9b10: 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ents} {socket do
9b20: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
9b30: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
9b40: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
9b50: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
9b60: 65 74 20 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 et socket10_9_te
9b70: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
9b80: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
9b90: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
9ba0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9bb0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
9bc0: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
9bd0: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 accept 8836]..p
9be0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
9bf0: 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 p} {.. fconfi
9c00: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
9c10: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c ng line.. fil
9c20: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
9c30: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
9c40: 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 ]..}..proc echo
9c50: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
9c60: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
9c70: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
9c80: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
9c90: 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 } else {...puts
9ca0: 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a $s $l.. }..}.
9cb0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
9cc0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9cd0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9ce0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
9cf0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9d00: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
9d10: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
9d20: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
9d30: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d fconfigure $s1 -
9d40: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
9d50: 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a set s2 [tls::
9d60: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9d70: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9d80: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9d90: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9da0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
9db0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
9dc0: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
9dd0: 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 ure $s2 -bufferi
9de0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
9df0: 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s3 [tls::socket
9e00: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9e10: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9e20: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9e30: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9e40: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9e50: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
9e60: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 fconfigure $s3
9e70: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
9e80: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
9e90: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
9ea0: 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 ncr i} {..puts $
9eb0: 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 s1 hello,s1..get
9ec0: 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 s $s1..puts $s2
9ed0: 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 hello,s2..gets $
9ee0: 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c s2..puts $s3 hel
9ef0: 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a lo,s3..gets $s3.
9f00: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
9f10: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
9f20: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
9f30: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9f40: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
9f50: 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _9_test_server}.
9f60: 20 20 20 20 73 65 74 20 69 0a 7d 20 31 30 30 20 set i.} 100
9f70: 20 20 20 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ..test tlsIO-
9f80: 31 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 11.8 {client wit
9f90: 68 20 73 65 76 65 72 61 6c 20 73 65 72 76 65 72 h several server
9fa0: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
9fb0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9fc0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
9fd0: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
9fe0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 74 6c 73 3a dCommand {..tls:
9ff0: 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 20 :init -certfile
a000: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
a010: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a020: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 0a file $serverKey.
a030: 09 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f .set s1 [tls::so
a040: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 cket -server "ac
a050: 63 65 70 74 20 34 30 30 33 22 20 34 30 30 33 5d cept 4003" 4003]
a060: 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 ..set s2 [tls::s
a070: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 ocket -server "a
a080: 63 63 65 70 74 20 34 30 30 34 22 20 34 30 30 34 ccept 4004" 4004
a090: 5d 0a 09 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a ]..set s3 [tls::
a0a0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 socket -server "
a0b0: 61 63 63 65 70 74 20 34 30 30 35 22 20 34 30 30 accept 4005" 400
a0c0: 35 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 5]..proc handsha
a0d0: 6b 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 20 20 20 ke {s mp} {..
a0e0: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
a0f0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 ...close $s..
a100: 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 } elseif {[catc
a110: 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b h {tls::handshak
a120: 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b e $s} result]} {
a130: 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 ...# Some errors
a140: 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 are normal...
a150: 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 73 } elseif {$res
a160: 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 ult == 1} {...#
a170: 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 Handshake comple
a180: 74 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 20 24 te...fileevent $
a190: 73 20 72 65 61 64 61 62 6c 65 20 22 22 0a 09 09 s readable ""...
a1a0: 70 75 74 73 20 24 73 20 24 6d 70 0a 09 09 63 6c puts $s $mp...cl
a1b0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d ose $s.. }..}
a1c0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 6d ..proc accept {m
a1d0: 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 p s a p} {..
a1e0: 23 20 54 68 65 73 65 20 68 61 76 65 20 74 6f 20 # These have to
a1f0: 61 63 63 65 70 74 20 6e 6f 6e 2d 62 6c 6f 63 6b accept non-block
a200: 69 6e 67 2c 20 62 65 63 61 75 73 65 20 74 68 65 ing, because the
a210: 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a 09 20 20 handshaking..
a220: 20 20 23 20 6f 72 64 65 72 20 69 73 6e 27 74 20 # order isn't
a230: 64 65 74 65 72 6d 69 6e 69 73 74 69 63 0a 09 20 deterministic..
a240: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
a250: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
a260: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 ffering line..
a270: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
a280: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 eadable [list ha
a290: 6e 64 73 68 61 6b 65 20 24 73 20 24 6d 70 5d 0a ndshake $s $mp].
a2a0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 6c 73 .}. }. tls
a2b0: 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c 65 ::init -certfile
a2c0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
a2d0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a2e0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
a2f0: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
a300: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
a310: 53 65 72 76 65 72 49 50 20 34 30 30 33 5d 0a 20 ServerIP 4003].
a320: 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a set s2 [tls::
a330: 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 socket $remoteSe
a340: 72 76 65 72 49 50 20 34 30 30 34 5d 0a 20 20 20 rverIP 4004].
a350: 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f set s3 [tls::so
a360: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
a370: 65 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 73 erIP 4005]. s
a380: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
a390: 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 5d end l [gets $s1]
a3a0: 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 [gets $s1] [eof
a3b0: 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 5d $s1] [gets $s2]
a3c0: 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 [gets $s2] [eof
a3d0: 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 $s2] \..[gets $
a3e0: 73 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 5b s3] [gets $s3] [
a3f0: 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f eof $s3]. clo
a400: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 se $s1. close
a410: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
a420: 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 s3. sendComma
a430: 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a nd {..close $s1.
a440: 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 .close $s2..clos
a450: 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 e $s3. }.
a460: 73 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d set l.} {4003 {}
a470: 20 31 20 34 30 30 34 20 7b 7d 20 31 20 34 30 30 1 4004 {} 1 400
a480: 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 5 {} 1}..test tl
a490: 73 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 sIO-11.9 {accept
a4a0: 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d callback error}
a4b0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
a4c0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
a4d0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
a4e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
a4f0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
a500: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
a510: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
a520: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
a530: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
a540: 74 20 38 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 t 8836]. proc
a550: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
a560: 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 {expr 10 / 0}.
a570: 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 proc bgerror a
a580: 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a rgs {..global x.
a590: 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 .set x $args.
a5a0: 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 }. sendCertV
a5b0: 61 6c 75 65 73 0a 20 20 20 20 69 66 20 7b 5b 63 alues. if {[c
a5c0: 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e atch {sendComman
a5d0: 64 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 65 d {.. set pee
a5e0: 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 rname [fconfigur
a5f0: 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 e $callerSocket
a600: 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 -peername]..
a610: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
a620: 65 74 20 5c 0a 09 09 20 20 20 20 2d 63 65 72 74 et \... -cert
a630: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
a640: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
a650: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
a660: 74 4b 65 79 20 5c 0a 09 09 20 20 20 20 5b 6c 69 tKey \... [li
a670: 6e 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 ndex $peername 0
a680: 5d 20 38 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f ] 8836].. clo
a690: 73 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d se $s. . }} m
a6a0: 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 sg]} {..close $s
a6b0: 0a 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 ..error $msg.
a6c0: 20 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 }. set timer
a6d0: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
a6e0: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
a6f0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
a700: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
a710: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
a720: 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 s. rename bge
a730: 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 rror {}. set
a740: 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 x.} {{divide by
a750: 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 zero}}..test tls
a760: 49 4f 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 6e IO-11.10 {testin
a770: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
a780: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b c options} {sock
a790: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
a7a0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
a7b0: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
a7c0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a7d0: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
a7e0: 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 _12_test_server
a7f0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a800: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
a810: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
a820: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a830: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
a840: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
a850: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
a860: 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 {s a p} {close
a870: 24 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s}. }. se
a880: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
a890: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
a8a0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
a8b0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
a8c0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
a8d0: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
a8e0: 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 ServerIP 8836].
a8f0: 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 set p [fconfi
a900: 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d gure $s -peernam
a910: 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 66 63 e]. set n [fc
a920: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 onfigure $s -soc
a930: 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c kname]. set l
a940: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
a950: 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 l [lindex $p 2]
a960: 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c [llength $p] [ll
a970: 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 63 6c ength $p]. cl
a980: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 ose $s. sendC
a990: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
a9a0: 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f ocket10_12_test_
a9b0: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
a9c0: 6c 0a 7d 20 7b 38 38 33 36 20 33 20 33 7d 0a 0a l.} {8836 3 3}..
a9d0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 31 test tlsIO-11.11
a9e0: 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f {testing spurio
a9f0: 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b us events} {sock
aa00: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
aa10: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
aa20: 20 20 23 20 72 65 6d 6f 74 65 20 65 71 75 69 76 # remote equiv
aa30: 61 6c 65 6e 74 20 6f 66 20 39 2e 31 0a 20 20 20 alent of 9.1.
aa40: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
aa50: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
aa60: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 5f 74 65 {..set socket_te
aa70: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
aa80: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
aa90: 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 ccept \...-certf
aaa0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
aab0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
aac0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
aad0: 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 Key 8836]..proc
aae0: 68 61 6e 64 73 68 61 6b 65 20 7b 73 7d 20 7b 0a handshake {s} {.
aaf0: 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 . if {[eof $s
ab00: 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a ]} {...close $s.
ab10: 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b . } elseif {[
ab20: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 catch {tls::hand
ab30: 73 68 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 shake $s} result
ab40: 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 ]} {...# Some er
ab50: 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e rors are normal.
ab60: 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b .. } elseif {
ab70: 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a $result == 1} {.
ab80: 09 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f ..# Handshake co
ab90: 6d 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 mplete...fileeve
aba0: 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 nt $s writable "
abb0: 22 0a 09 09 61 66 74 65 72 20 31 30 30 20 77 72 "...after 100 wr
abc0: 69 74 65 73 6f 6d 65 20 24 73 0a 09 20 20 20 20 itesome $s..
abd0: 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 }..}..proc accep
abe0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
abf0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
ac00: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 translation "aut
ac10: 6f 20 6c 66 22 0a 09 20 20 20 20 66 69 6c 65 65 o lf".. filee
ac20: 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 vent $s writable
ac30: 20 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 [list handshake
ac40: 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 77 72 $s]..}..proc wr
ac50: 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 itesome {s} {..
ac60: 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d for {set i 0}
ac70: 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 {$i < 100} {inc
ac80: 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 r i} {...puts $s
ac90: 20 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 "line $i from r
aca0: 65 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 20 emote server"..
acb0: 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 }.. close
acc0: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
acd0: 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 set len 0. se
ace0: 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 t spurious 0.
acf0: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
ad00: 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 proc readlittle
ad10: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 {s} {..global sp
ad20: 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a urious done len.
ad30: 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 .set l [read $s
ad40: 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 1]..if {[string
ad50: 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d length $l] == 0}
ad60: 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f {.. if {![eo
ad70: 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 f $s]} {...incr
ad80: 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 spurious.. }
ad90: 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 else {...close $
ada0: 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 s...set done 1..
adb0: 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a }..} else {.
adc0: 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 . incr len [s
add0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
ade0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
adf0: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
ae00: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
ae10: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
ae20: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
ae30: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
ae40: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
ae50: 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 ServerIP 8836].
ae60: 20 20 20 23 20 47 65 74 20 74 68 65 20 62 75 66 # Get the buf
ae70: 66 65 72 69 6e 67 20 63 6f 72 72 65 63 74 65 64 fering corrected
ae80: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
ae90: 24 63 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $c -buffering li
aea0: 6e 65 0a 20 20 20 20 23 20 50 75 74 20 61 20 62 ne. # Put a b
aeb0: 79 74 65 20 69 6e 74 6f 20 74 68 65 20 63 6c 69 yte into the cli
aec0: 65 6e 74 20 70 69 70 65 20 74 6f 20 74 72 69 67 ent pipe to trig
aed0: 67 65 72 20 54 4c 53 20 68 61 6e 64 73 68 61 6b ger TLS handshak
aee0: 69 6e 67 0a 20 20 20 20 70 75 74 73 20 24 63 20 ing. puts $c
aef0: 61 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 a. fileevent
af00: 24 63 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $c readable [lis
af10: 74 20 72 65 61 64 6c 69 74 74 6c 65 20 24 63 5d t readlittle $c]
af20: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
af30: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
af40: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
af50: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
af60: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
af70: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e l $timer. sen
af80: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
af90: 24 73 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 $socket_test_ser
afa0: 76 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 ver}. list $s
afb0: 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b purious $len.} {
afc0: 30 20 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 0 2690}..test tl
afd0: 73 49 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 sIO-11.12 {testi
afe0: 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 ng EOF stickynes
aff0: 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 s} {unexplainedF
b000: 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 6f ailure socket do
b010: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
b020: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 erver} {. # r
b030: 65 6d 6f 74 65 20 65 71 75 69 76 61 6c 65 6e 74 emote equivalent
b040: 20 6f 66 20 39 2e 33 0a 20 20 20 20 23 20 48 4f of 9.3. # HO
b050: 42 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 BBS: never worke
b060: 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 d correctly.
b070: 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 set counter 0.
b080: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
b090: 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b proc count_up {
b0a0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
b0b0: 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 65 72 5f nter done after_
b0c0: 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 id..set l [gets
b0d0: 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 $s]..if {[eof $s
b0e0: 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 ]} {.. incr c
b0f0: 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 66 20 7b ounter.. if {
b100: 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a $counter > 9} {.
b110: 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 ..set done {EOF
b120: 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 is sticky}...aft
b130: 65 72 20 63 61 6e 63 65 6c 20 24 61 66 74 65 72 er cancel $after
b140: 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 _id...close $s..
b150: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
b160: 20 20 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 proc timed_ou
b170: 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 t {} {..global c
b180: 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 done..set done
b190: 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 {timed_out, EOF
b1a0: 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 is not sticky}..
b1b0: 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 close $c. }.
b1c0: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
b1d0: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
b1e0: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
b1f0: 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 0_14_test_server
b200: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
b210: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
b220: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
b230: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
b240: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 $serverKey \...
b250: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
b260: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
b270: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
b280: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
b290: 24 73 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 $s.. after 10
b2a0: 30 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 0 close $s..}.
b2b0: 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 }. set c [t
b2c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
b2d0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
b2e0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
b2f0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
b300: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
b310: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
b320: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 69 6c IP 8836]. fil
b330: 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 eevent $c readab
b340: 6c 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 le "count_up $c"
b350: 0a 20 20 20 20 73 65 74 20 61 66 74 65 72 5f 69 . set after_i
b360: 64 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 d [after 1000 ti
b370: 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 med_out]. vwa
b380: 69 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 it done. send
b390: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
b3a0: 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 socket10_14_test
b3b0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
b3c0: 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 done.} {EOF is
b3d0: 73 74 69 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c sticky}..test tl
b3e0: 73 49 4f 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 sIO-11.13 {testi
b3f0: 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 ng async write,
b400: 61 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 async flush, asy
b410: 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f nc close} \..{so
b420: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
b430: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
b440: 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 proc readit
b450: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f {s} {..global co
b460: 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 unt done..set l
b470: 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 [read $s]..incr
b480: 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 count [string le
b490: 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 ngth $l]..if {[e
b4a0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 of $s]} {.. c
b4b0: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 lose $s.. set
b4c0: 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d done 1..}. }
b4d0: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
b4e0: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
b4f0: 61 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 74 and {..set first
b500: 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 block [string re
b510: 70 65 61 74 20 61 20 33 31 5d 0a 09 73 65 74 20 peat a 31]..set
b520: 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 secondblock [str
b530: 69 6e 67 20 72 65 70 65 61 74 20 62 20 36 35 35 ing repeat b 655
b540: 33 35 5d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 35]..set l [tls:
b550: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
b560: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
b570: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
b580: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
b590: 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 erKey \...-serve
b5a0: 72 20 61 63 63 65 70 74 20 38 38 34 35 5d 0a 09 r accept 8845]..
b5b0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
b5c0: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
b5d0: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
b5e0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
b5f0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 -blocking 0 -tra
b600: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
b610: 66 65 72 73 69 7a 65 20 31 36 33 38 34 20 5c 0a fersize 16384 \.
b620: 09 09 20 20 20 20 2d 62 75 66 66 65 72 69 6e 67 .. -buffering
b630: 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 line.. filee
b640: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
b650: 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 09 "readable $s"..
b660: 7d 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c 65 }..proc readable
b670: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 {s} {.. set
b680: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 l [gets $s]..
b690: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
b6a0: 61 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 adable {}.. a
b6b0: 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e fter 1000 respon
b6c0: 64 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 d $s..}..proc re
b6d0: 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 spond {s} {..
b6e0: 20 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f global firstblo
b6f0: 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f ck.. puts -no
b700: 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 newline $s $firs
b710: 74 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 tblock.. afte
b720: 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 r 1000 writedata
b730: 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 $s..}..proc wri
b740: 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 tedata {s} {..
b750: 20 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 global secondb
b760: 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d lock.. puts -
b770: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 nonewline $s $se
b780: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 condblock.. c
b790: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
b7a0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
b7b0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
b7c0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
b7d0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b7e0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
b7f0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
b800: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
b810: 38 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8845]. fconfi
b820: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
b830: 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e g 0 -translation
b840: 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c lf -buffering l
b850: 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e ine. set coun
b860: 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 t 0. puts $s
b870: 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 hello. fileev
b880: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
b890: 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 "readit $s".
b8a0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
b8b0: 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 10000 "set done
b8c0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
b8d0: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
b8e0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
b8f0: 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d mer. sendComm
b900: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 and {close $l}.
b910: 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 set count.} 6
b920: 35 35 36 36 0a 0a 74 65 73 74 20 74 6c 73 49 4f 5566..test tlsIO
b930: 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 69 -12.1 {testing i
b940: 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 73 65 nheritance of se
b950: 72 76 65 72 20 73 6f 63 6b 65 74 73 7d 20 7b 73 rver sockets} {s
b960: 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 20 ocket exec} {.
b970: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
b980: 72 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 ript1. makeFi
b990: 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 le {} script2..
b9a0: 20 20 20 23 20 53 63 72 69 70 74 31 20 69 73 20 # Script1 is
b9b0: 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 just a 10 second
b9c0: 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 delay. If the
b9d0: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 server socket.
b9e0: 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 # is inherited
b9f0: 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c , it will be hel
ba00: 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 d open for 10 se
ba10: 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 conds.. set f
ba20: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 [open script1 w
ba30: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
ba40: 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 .after 10000 exi
ba50: 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 t..vwait forever
ba60: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
ba70: 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 $f.. # Scrip
ba80: 74 32 20 63 72 65 61 74 65 73 20 74 68 65 20 73 t2 creates the s
ba90: 65 72 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c 61 erver socket, la
baa0: 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 2c 0a unches script1,.
bab0: 20 20 20 20 23 20 77 61 69 74 73 20 61 20 73 65 # waits a se
bac0: 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 2e cond, and exits.
bad0: 20 20 54 68 65 20 73 65 72 76 65 72 20 73 6f 63 The server soc
bae0: 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 ket will now.
baf0: 20 23 20 62 65 20 63 6c 6f 73 65 64 20 75 6e 6c # be closed unl
bb00: 65 73 73 20 73 63 72 69 70 74 31 20 69 6e 68 65 ess script1 inhe
bb10: 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 73 rited it... s
bb20: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
bb30: 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t2 w]. puts $
bb40: 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 f [list set tcls
bb50: 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 h $::tcltest::tc
bb60: 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 ltest]. puts
bb70: 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 71 75 $f {package requ
bb80: 69 72 65 20 74 6c 73 7d 0a 20 20 20 20 70 75 74 ire tls}. put
bb90: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
bba0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
bbb0: 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 r accept \..
bbc0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
bbd0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
bbe0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
bbf0: 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 5c 5d serverKey 8828\]
bc00: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
bc10: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 .proc accept { f
bc20: 69 6c 65 20 61 64 64 72 20 70 6f 72 74 20 7d 20 ile addr port }
bc30: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 66 69 {.. close $fi
bc40: 6c 65 0a 09 7d 0a 09 65 78 65 63 20 24 74 63 6c le..}..exec $tcl
bc50: 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 63 6c sh script1 &..cl
bc60: 6f 73 65 20 24 66 0a 09 61 66 74 65 72 20 31 30 ose $f..after 10
bc70: 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 00 exit..vwait f
bc80: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
bc90: 20 63 6c 6f 73 65 20 24 66 0a 09 0a 20 20 20 20 close $f...
bca0: 23 20 4c 61 75 6e 63 68 20 73 63 72 69 70 74 32 # Launch script2
bcb0: 20 61 6e 64 20 77 61 69 74 20 35 20 73 65 63 6f and wait 5 seco
bcc0: 6e 64 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a nds.. exec $:
bcd0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
bce0: 74 20 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 t script2 &.
bcf0: 61 66 74 65 72 20 35 30 30 30 20 7b 20 73 65 74 after 5000 { set
bd00: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 ok_to_proceed 1
bd10: 20 7d 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f }. vwait ok_
bd20: 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 to_proceed..
bd30: 23 20 49 66 20 77 65 20 63 61 6e 20 73 74 69 6c # If we can stil
bd40: 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 l connect to the
bd50: 20 73 65 72 76 65 72 2c 20 74 68 65 20 73 6f 63 server, the soc
bd60: 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 69 74 65 ket got inherite
bd70: 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 d... if {[cat
bd80: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
bd90: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
bda0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
bdb0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
bdc0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
bdd0: 20 20 09 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 . 127.0.0.1 88
bde0: 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 28} msg]} {..set
bdf0: 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 x {server socke
be00: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
be10: 74 65 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 ted}. } else
be20: 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 73 {..close $msg..s
be30: 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 et x {server soc
be40: 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 ket was inherite
be50: 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 d}. }.. se
be60: 74 20 78 0a 7d 20 7b 73 65 72 76 65 72 20 73 6f t x.} {server so
be70: 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 cket was not inh
be80: 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c erited}..test tl
be90: 73 49 4f 2d 31 32 2e 32 20 7b 74 65 73 74 69 6e sIO-12.2 {testin
bea0: 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 g inheritance of
beb0: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 73 7d client sockets}
bec0: 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b {socket exec} {
bed0: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
bee0: 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b script1. mak
bef0: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 eFile {} script2
bf00: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 .. # Script1
bf10: 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 is just a 10 sec
bf20: 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 ond delay. If t
bf30: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
bf40: 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 . # is inheri
bf50: 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 ted, it will be
bf60: 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 held open for 10
bf70: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 seconds.. se
bf80: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
bf90: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
bfa0: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
bfb0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
bfc0: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
bfd0: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 ose $f.. # Sc
bfe0: 72 69 70 74 32 20 6f 70 65 6e 73 20 74 68 65 20 ript2 opens the
bff0: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 61 6e client socket an
c000: 64 20 77 72 69 74 65 73 20 74 6f 20 69 74 2e 20 d writes to it.
c010: 20 49 74 20 74 68 65 6e 0a 20 20 20 20 23 20 6c It then. # l
c020: 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 20 aunches script1
c030: 61 6e 64 20 65 78 69 74 73 2e 20 20 49 66 20 74 and exits. If t
c040: 68 65 20 63 68 69 6c 64 20 70 72 6f 63 65 73 73 he child process
c050: 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 0a 20 inherited the.
c060: 20 20 20 23 20 63 6c 69 65 6e 74 20 73 6f 63 6b # client sock
c070: 65 74 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 77 et, the socket w
c080: 69 6c 6c 20 73 74 69 6c 6c 20 62 65 20 6f 70 65 ill still be ope
c090: 6e 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f n... set f [o
c0a0: 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 pen script2 w].
c0b0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
c0c0: 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 set tclsh $::tc
c0d0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a ltest::tcltest].
c0e0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 70 61 63 puts $f {pac
c0f0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
c100: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
c110: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
c120: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
c130: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
c140: 20 24 63 61 43 65 72 74 20 5c 0a 09 20 20 20 20 $caCert \..
c150: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
c160: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
c170: 32 39 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 29\]". puts $
c180: 66 20 7b 0a 09 65 78 65 63 20 24 74 63 6c 73 68 f {..exec $tclsh
c190: 20 73 63 72 69 70 74 31 20 26 0a 09 70 75 74 73 script1 &..puts
c1a0: 20 24 66 20 74 65 73 74 69 6e 67 0a 09 66 6c 75 $f testing..flu
c1b0: 73 68 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 sh $f..after 100
c1c0: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
c1d0: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
c1e0: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
c1f0: 43 72 65 61 74 65 20 74 68 65 20 73 65 72 76 65 Create the serve
c200: 72 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 65 r socket.. se
c210: 74 20 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t server [tls::s
c220: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
c230: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
c240: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
c250: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
c260: 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 verKey \.. -s
c270: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
c280: 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 9]. proc acce
c290: 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 pt { file host p
c2a0: 6f 72 74 20 7d 20 7b 0a 09 23 20 57 68 65 6e 20 ort } {..# When
c2b0: 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 the client conne
c2c0: 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 20 74 cts, establish t
c2d0: 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 72 0a he read handler.
c2e0: 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a 09 .global server..
c2f0: 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a 09 66 close $server..f
c300: 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 configure $file
c310: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c -blocking 0..fil
c320: 65 65 76 65 6e 74 20 24 66 69 6c 65 20 72 65 61 eevent $file rea
c330: 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 dable [list do_h
c340: 61 6e 64 73 68 61 6b 65 20 24 66 69 6c 65 20 72 andshake $file r
c350: 65 61 64 61 62 6c 65 20 67 65 74 64 61 74 61 20 eadable getdata
c360: 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c \...-buffering l
c370: 69 6e 65 5d 0a 09 72 65 74 75 72 6e 0a 20 20 20 ine]..return.
c380: 20 7d 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 }. proc getd
c390: 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a 09 ata { file } {..
c3a0: 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f # Read handler o
c3b0: 6e 20 74 68 65 20 61 63 63 65 70 74 65 64 20 73 n the accepted s
c3c0: 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 ocket...global x
c3d0: 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a ..global failed.
c3e0: 09 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 .set status [cat
c3f0: 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 ch {read $file}
c400: 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 data]..if {$stat
c410: 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 us != 0} {..
c420: 73 65 74 20 78 20 7b 72 65 61 64 20 66 61 69 6c set x {read fail
c430: 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 ed, error was $d
c440: 61 74 61 7d 0a 09 20 20 20 20 63 61 74 63 68 20 ata}.. catch
c450: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
c460: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 .} elseif {[stri
c470: 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 ng compare {} $d
c480: 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 ata]} {..} elsei
c490: 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 f {[fblocked $fi
c4a0: 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 le]} {..} elseif
c4b0: 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b {[eof $file]} {
c4c0: 0a 09 20 20 20 20 69 66 20 7b 24 66 61 69 6c 65 .. if {$faile
c4d0: 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b 63 6c d} {...set x {cl
c4e0: 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 ient socket was
c4f0: 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 inherited}..
c500: 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 } else {...set x
c510: 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 {client socket
c520: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
c530: 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 d}.. }.. c
c540: 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 atch { close $fi
c550: 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 le }..} else {..
c560: 20 20 20 20 73 65 74 20 78 20 7b 69 6d 70 6f 73 set x {impos
c570: 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 20 sible case}..
c580: 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 catch { close $
c590: 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 72 file }..}..retur
c5a0: 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 49 n. }.. # I
c5b0: 66 20 74 68 65 20 73 6f 63 6b 65 74 20 64 6f 65 f the socket doe
c5c0: 73 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 2d sn't hit end-of-
c5d0: 66 69 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e 64 file in 5 second
c5e0: 73 2c 20 74 68 65 0a 20 20 20 20 23 20 73 63 72 s, the. # scr
c5f0: 69 70 74 31 20 70 72 6f 63 65 73 73 20 6d 75 73 ipt1 process mus
c600: 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 t have inherited
c610: 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 20 the client...
c620: 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 set failed 0.
c630: 20 20 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c after 5000 [l
c640: 69 73 74 20 73 65 74 20 66 61 69 6c 65 64 20 31 ist set failed 1
c650: 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 ].. # Launch
c660: 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 the script2 proc
c670: 65 73 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a ess.. exec $:
c680: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
c690: 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 t script2 &..
c6a0: 20 76 77 61 69 74 20 78 0a 20 20 20 20 69 66 20 vwait x. if
c6b0: 7b 21 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76 77 {!$failed} {..vw
c6c0: 61 69 74 20 66 61 69 6c 65 64 0a 20 20 20 20 7d ait failed. }
c6d0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6c . set x.} {cl
c6e0: 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 ient socket was
c6f0: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
c700: 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 33 20 test tlsIO-12.3
c710: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
c720: 61 6e 63 65 20 6f 66 20 61 63 63 65 70 74 65 64 ance of accepted
c730: 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f sockets} \..{so
c740: 63 6b 65 74 20 65 78 65 63 20 75 6e 69 78 4f 6e cket exec unixOn
c750: 6c 79 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 ly} {. makeFi
c760: 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 le {} script1.
c770: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
c780: 72 69 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 ript2.. set f
c790: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 [open script1 w
c7a0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
c7b0: 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 .after 10000 exi
c7c0: 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 t..vwait forever
c7d0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
c7e0: 20 24 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b $f.. set f [
c7f0: 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a open script2 w].
c800: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
c810: 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 t set tclsh $::t
c820: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d cltest::tcltest]
c830: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 70 61 . puts $f {pa
c840: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
c850: 73 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 s}. puts $f "
c860: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
c870: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
c880: 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 pt \.. -certf
c890: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
c8a0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
c8b0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
c8c0: 4b 65 79 20 38 39 33 30 5c 5d 22 0a 20 20 20 20 Key 8930\]".
c8d0: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
c8e0: 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f accept { file ho
c8f0: 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 st port } {..
c900: 20 67 6c 6f 62 61 6c 20 74 63 6c 73 68 0a 09 20 global tclsh..
c910: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
c920: 69 6c 65 20 2d 62 75 66 66 65 72 69 6e 67 20 6c ile -buffering l
c930: 69 6e 65 0a 09 20 20 20 20 70 75 74 73 20 24 66 ine.. puts $f
c940: 69 6c 65 20 7b 74 65 73 74 20 64 61 74 61 20 6f ile {test data o
c950: 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 20 65 n socket}.. e
c960: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
c970: 74 31 20 26 0a 09 20 20 20 20 61 66 74 65 72 20 t1 &.. after
c980: 31 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 76 77 1000 exit..}..vw
c990: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
c9a0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
c9b0: 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 # Launch the
c9c0: 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 script2 process
c9d0: 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 and connect to
c9e0: 69 74 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e it. See how lon
c9f0: 67 0a 20 20 20 20 23 20 74 68 65 20 73 6f 63 6b g. # the sock
ca00: 65 74 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 et stays open..
ca10: 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 exec $::tclte
ca20: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
ca30: 70 74 32 20 26 0a 0a 20 20 20 20 61 66 74 65 72 pt2 &.. after
ca40: 20 32 30 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 2000 set ok_to_
ca50: 70 72 6f 63 65 65 64 20 31 0a 20 20 20 20 76 77 proceed 1. vw
ca60: 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 ait ok_to_procee
ca70: 64 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c d.. set f [tl
ca80: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
ca90: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
caa0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
cab0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
cac0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
cad0: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 39 33 30 127.0.0.1 8930
cae0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
caf0: 20 24 66 20 2d 62 75 66 66 65 72 69 6e 67 20 66 $f -buffering f
cb00: 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a ull -blocking 0.
cb10: 20 20 20 20 23 20 57 65 20 6e 65 65 64 20 74 6f # We need to
cb20: 20 70 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f put a byte into
cb30: 20 74 68 65 20 72 65 61 64 20 71 75 65 75 65 2c the read queue,
cb40: 20 6f 74 68 65 72 77 69 73 65 20 74 68 65 0a 20 otherwise the.
cb50: 20 20 20 23 20 54 4c 53 20 68 61 6e 64 73 68 61 # TLS handsha
cb60: 6b 65 20 64 6f 65 73 6e 27 74 20 66 69 6e 69 73 ke doesn't finis
cb70: 68 0a 20 20 20 20 70 75 74 73 20 24 66 20 61 3b h. puts $f a;
cb80: 20 66 6c 75 73 68 20 24 66 0a 20 20 20 20 66 69 flush $f. fi
cb90: 6c 65 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 leevent $f reada
cba0: 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 ble [list getdat
cbb0: 61 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 a $f].. # If
cbc0: 74 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 74 the socket is st
cbd0: 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 35 ill open after 5
cbe0: 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 seconds, the sc
cbf0: 72 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 20 ript1 process.
cc00: 20 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 6e # must have in
cc10: 68 65 72 69 74 65 64 20 74 68 65 20 61 63 63 65 herited the acce
cc20: 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 pted socket...
cc30: 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 set failed 0.
cc40: 20 20 20 61 66 74 65 72 20 35 30 30 30 20 73 65 after 5000 se
cc50: 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 t failed 1..
cc60: 70 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 proc getdata { f
cc70: 69 6c 65 20 7d 20 7b 0a 09 23 20 52 65 61 64 20 ile } {..# Read
cc80: 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 63 handler on the c
cc90: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2e 0a 09 67 lient socket...g
cca0: 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 lobal x..global
ccb0: 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 74 failed..set stat
ccc0: 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 us [catch {read
ccd0: 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 66 $file} data]..if
cce0: 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d 20 {$status != 0}
ccf0: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 22 72 65 {.. set x "re
cd00: 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 ad failed, error
cd10: 20 77 61 73 20 24 64 61 74 61 22 0a 09 20 20 20 was $data"..
cd20: 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 catch { close $
cd30: 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 66 file }..} elseif
cd40: 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 {[string compar
cd50: 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a 09 e {} $data]} {..
cd60: 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 } elseif {[fbloc
cd70: 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d ked $file]} {..}
cd80: 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 elseif {[eof $f
cd90: 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 ile]} {.. if
cda0: 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 65 {$failed} {...se
cdb0: 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 73 6f t x {accepted so
cdc0: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
cdd0: 65 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ed}.. } else
cde0: 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 63 65 70 {...set x {accep
cdf0: 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ted socket was n
ce00: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 ot inherited}..
ce10: 20 20 20 7d 0a 09 20 20 20 20 63 61 74 63 68 20 }.. catch
ce20: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
ce30: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 .} else {.. s
ce40: 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 et x {impossible
ce50: 20 63 61 73 65 7d 0a 09 20 20 20 20 63 61 74 63 case}.. catc
ce60: 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 h { close $file
ce70: 7d 0a 09 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 }..}..return.
ce80: 20 7d 0a 20 20 20 20 0a 20 20 20 20 76 77 61 69 }. . vwai
ce90: 74 20 78 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 t x. set x.}
cea0: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
ceb0: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
cec0: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
ced0: 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 75 73 13.1 {Testing us
cee0: 65 20 6f 66 20 73 68 61 72 65 64 20 73 6f 63 6b e of shared sock
cef0: 65 74 20 62 65 74 77 65 65 6e 20 74 77 6f 20 74 et between two t
cf00: 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b hreads} \..{sock
cf10: 65 74 20 74 65 73 74 74 68 72 65 61 64 7d 20 7b et testthread} {
cf20: 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 . # HOBBS: ne
cf30: 76 65 72 20 74 65 73 74 65 64 0a 20 20 20 20 72 ver tested. r
cf40: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
cf50: 0a 20 20 20 20 74 68 72 65 61 64 52 65 61 70 0a . threadReap.
cf60: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a . makeFile {.
cf70: 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 .package req
cf80: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66 20 uire tls..set f
cf90: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
cfa0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 rver accept 8828
cfb0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
cfc0: 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 s a p} {.
cfd0: 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 fileevent $
cfe0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
cff0: 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 echo $s].
d000: 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 fconfigure
d010: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
d020: 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 ine. }..p
d030: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
d040: 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 global i.
d050: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c set l
d060: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 [gets $s].
d070: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 if {[eof
d080: 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 $s]} {.
d090: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
d0a0: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
d0b0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
d0c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
d0d0: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
d0e0: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 } else { ..
d0f0: 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a incr i.
d100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d110: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
d120: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 }..}..s
d130: 65 74 20 69 20 30 0a 09 76 77 61 69 74 20 78 0a et i 0..vwait x.
d140: 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 74 68 .close $f...# th
d150: 72 65 61 64 20 63 6c 65 61 6e 73 20 69 74 73 65 read cleans itse
d160: 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 68 72 65 lf up...testthre
d170: 61 64 20 65 78 69 74 0a 20 20 20 20 7d 20 73 63 ad exit. } sc
d180: 72 69 70 74 0a 20 20 20 20 0a 20 20 20 20 23 20 ript. . #
d190: 63 72 65 61 74 65 20 61 20 74 68 72 65 61 64 0a create a thread.
d1a0: 20 20 20 20 73 65 74 20 73 65 72 76 65 72 74 68 set serverth
d1b0: 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 61 64 read [testthread
d1c0: 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 63 65 create { source
d1d0: 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 20 20 script } ].
d1e0: 75 70 64 61 74 65 0a 20 20 20 20 0a 20 20 20 20 update. .
d1f0: 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 after 1000. s
d200: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
d210: 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 t 127.0.0.1 8828
d220: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
d230: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
d240: 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 20 7b ine.. catch {
d250: 0a 09 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f ..puts $s "hello
d260: 22 0a 09 67 65 74 73 20 24 73 20 72 65 73 75 6c "..gets $s resul
d270: 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 t. }. clos
d280: 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a e $s. update.
d290: 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 30 0a . after 2000.
d2a0: 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 lappend resu
d2b0: 6c 74 20 5b 74 68 72 65 61 64 52 65 61 70 5d 0a lt [threadReap].
d2c0: 20 20 20 20 0a 20 20 20 20 73 65 74 20 72 65 73 . set res
d2d0: 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d ult..} {hello 1}
d2e0: 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b ..# cleanup.if {
d2f0: 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 73 6f [string match so
d300: 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ck* $commandSock
d310: 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 et] == 1} {. p
d320: 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b uts $commandSock
d330: 65 74 20 65 78 69 74 0a 20 20 20 66 6c 75 73 68 et exit. flush
d340: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a $commandSocket.
d350: 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 }.catch {close $
d360: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 commandSocket}.c
d370: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d atch {close $rem
d380: 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 oteProcChan}.::t
d390: 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 cltest::cleanupT
d3a0: 65 73 74 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 ests.flush stdou
d3b0: 74 0a 72 65 74 75 72 6e 0a t.return.