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 39 20 32 30 30 32 2f 30 32 2f 30 34 20 32 .19 2002/02/04 2
0210: 32 3a 34 35 3a 31 31 20 68 6f 62 62 73 20 45 78 2:45:11 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 54 68 65 20 62 75 69 6c 64 *.}..# The build
0bc0: 20 64 69 72 20 69 73 20 61 64 64 65 64 20 61 73 dir is added as
0bd0: 20 74 68 65 20 66 69 72 73 74 20 65 6c 65 6d 65 the first eleme
0be0: 6e 74 20 6f 66 20 24 50 41 54 48 0a 73 65 74 20 nt of $PATH.set
0bf0: 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 auto_path [linse
0c00: 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 rt $auto_path 0
0c10: 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 [lindex [split $
0c20: 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 env(PATH) ";:"]
0c30: 30 5d 5d 0a 23 20 4c 6f 61 64 20 74 68 65 20 74 0]].# Load the t
0c40: 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 63 6b 61 ls package.packa
0c50: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 20 31 ge require tls 1
0c60: 2e 34 0a 0a 73 65 74 20 74 6c 73 53 65 72 76 65 .4..set tlsServe
0c70: 72 50 6f 72 74 20 38 30 34 38 0a 0a 23 20 53 70 rPort 8048..# Sp
0c80: 65 63 69 66 79 20 77 68 65 72 65 20 74 68 65 20 ecify where the
0c90: 63 65 72 74 69 66 69 63 61 74 65 73 20 61 72 65 certificates are
0ca0: 0a 0a 73 65 74 20 63 65 72 74 73 44 69 72 09 5b ..set certsDir.[
0cb0: 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 file join [file
0cc0: 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 dirname [info sc
0cd0: 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a 73 65 ript]] certs].se
0ce0: 74 20 73 65 72 76 65 72 43 65 72 74 09 5b 66 69 t serverCert.[fi
0cf0: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
0d00: 72 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a 73 65 r server.pem].se
0d10: 74 20 63 6c 69 65 6e 74 43 65 72 74 09 5b 66 69 t clientCert.[fi
0d20: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
0d30: 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 65 r client.pem].se
0d40: 74 20 63 61 43 65 72 74 09 5b 66 69 6c 65 20 6a t caCert.[file j
0d50: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 oin $certsDir ca
0d60: 2e 70 65 6d 5d 0a 73 65 74 20 73 65 72 76 65 72 .pem].set server
0d70: 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 Key.[file join $
0d80: 63 65 72 74 73 44 69 72 20 73 65 72 76 65 72 2e certsDir server.
0d90: 6b 65 79 5d 0a 73 65 74 20 63 6c 69 65 6e 74 4b key].set clientK
0da0: 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 ey.[file join $c
0db0: 65 72 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 6b ertsDir client.k
0dc0: 65 79 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 ey]..# Some test
0dd0: 73 20 72 65 71 75 69 72 65 20 74 68 65 20 74 65 s require the te
0de0: 73 74 74 68 72 65 61 64 20 61 6e 64 20 65 78 65 stthread and exe
0df0: 63 20 63 6f 6d 6d 61 6e 64 73 0a 0a 73 65 74 20 c commands..set
0e00: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 ::tcltest::testC
0e10: 6f 6e 73 74 72 61 69 6e 74 73 28 74 65 73 74 74 onstraints(testt
0e20: 68 72 65 61 64 29 20 5c 0a 09 5b 65 78 70 72 20 hread) \..[expr
0e30: 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 {[info commands
0e40: 74 65 73 74 74 68 72 65 61 64 5d 20 21 3d 20 7b testthread] != {
0e50: 7d 7d 5d 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 }}].set ::tcltes
0e60: 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e t::testConstrain
0e70: 74 73 28 65 78 65 63 29 20 5b 65 78 70 72 20 7b ts(exec) [expr {
0e80: 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 [info commands e
0e90: 78 65 63 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a xec] != {}}]..#.
0ea0: 23 20 49 66 20 72 65 6d 6f 74 65 53 65 72 76 65 # If remoteServe
0eb0: 72 49 50 20 6f 72 20 72 65 6d 6f 74 65 53 65 72 rIP or remoteSer
0ec0: 76 65 72 50 6f 72 74 20 61 72 65 20 6e 6f 74 20 verPort are not
0ed0: 73 65 74 2c 20 63 68 65 63 6b 20 69 6e 20 74 68 set, check in th
0ee0: 65 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 e.# environment
0ef0: 76 61 72 69 61 62 6c 65 73 20 66 6f 72 20 65 78 variables for ex
0f00: 74 65 72 6e 61 6c 6c 79 20 73 65 74 20 76 61 6c ternally set val
0f10: 75 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e ues..#..if {![in
0f20: 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 fo exists remote
0f30: 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 20 20 20 ServerIP]} {.
0f40: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 if {[info exist
0f50: 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 s env(remoteServ
0f60: 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 72 erIP)]} {..set r
0f70: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 65 emoteServerIP $e
0f80: 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 nv(remoteServerI
0f90: 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 P). }.}.if {!
0fa0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
0fb0: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 oteServerPort]}
0fc0: 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 {. if {[info
0fd0: 65 78 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 exists env(remot
0fe0: 65 53 65 72 76 65 72 50 6f 72 74 29 5d 7d 20 7b eServerPort)]} {
0ff0: 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 ..set remoteServ
1000: 65 72 50 6f 72 74 20 24 65 6e 76 28 72 65 6d 6f erPort $env(remo
1010: 74 65 53 65 72 76 65 72 50 6f 72 74 29 0a 20 20 teServerPort).
1020: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
1030: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
1040: 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 sts remoteServer
1050: 49 50 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 IP]} {.. set
1060: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
1070: 20 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 0a $tlsServerPort.
1080: 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a }. }.
1090: 7d 0a 0a 70 72 6f 63 20 64 6f 5f 68 61 6e 64 73 }..proc do_hands
10a0: 68 61 6b 65 20 7b 73 20 7b 74 79 70 65 20 72 65 hake {s {type re
10b0: 61 64 61 62 6c 65 7d 20 7b 63 6d 64 20 7b 7d 7d adable} {cmd {}}
10c0: 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 69 66 20 args} {. if
10d0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 63 6c {[eof $s]} {..cl
10e0: 6f 73 65 20 24 73 0a 09 64 70 75 74 73 20 22 68 ose $s..dputs "h
10f0: 61 6e 64 73 68 61 6b 65 3a 20 65 6f 66 22 0a 09 andshake: eof"..
1100: 73 65 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 68 61 set ::do_handsha
1110: 6b 65 20 22 65 6f 66 22 0a 20 20 20 20 7d 20 65 ke "eof". } e
1120: 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 lseif {[catch {t
1130: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
1140: 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 23 20 } result]} {..#
1150: 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 65 20 Some errors are
1160: 6e 6f 72 6d 61 6c 2e 0a 09 64 70 75 74 73 20 22 normal...dputs "
1170: 68 61 6e 64 73 68 61 6b 65 3a 20 24 72 65 73 75 handshake: $resu
1180: 6c 74 22 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 lt". } elseif
1190: 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 {$result == 1}
11a0: 7b 0a 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 {..# Handshake c
11b0: 6f 6d 70 6c 65 74 65 0a 09 69 66 20 7b 5b 6c 6c omplete..if {[ll
11c0: 65 6e 67 74 68 20 24 61 72 67 73 5d 7d 20 7b 20 ength $args]} {
11d0: 65 76 61 6c 20 5b 6c 69 73 74 20 66 63 6f 6e 66 eval [list fconf
11e0: 69 67 75 72 65 20 24 73 5d 20 24 61 72 67 73 20 igure $s] $args
11f0: 7d 0a 09 69 66 20 7b 24 63 6d 64 20 3d 3d 20 22 }..if {$cmd == "
1200: 22 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 "} {.. fileev
1210: 65 6e 74 20 24 73 20 24 74 79 70 65 20 22 22 0a ent $s $type "".
1220: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 66 .} else {.. f
1230: 69 6c 65 65 76 65 6e 74 20 24 73 20 24 74 79 70 ileevent $s $typ
1240: 65 20 22 24 63 6d 64 20 5b 6c 69 73 74 20 24 73 e "$cmd [list $s
1250: 5d 22 0a 09 7d 0a 09 64 70 75 74 73 20 22 68 61 ]"..}..dputs "ha
1260: 6e 64 73 68 61 6b 65 3a 20 63 6f 6d 70 6c 65 74 ndshake: complet
1270: 65 22 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 61 6e e"..set ::do_han
1280: 64 73 68 61 6b 65 20 22 63 6f 6d 70 6c 65 74 65 dshake "complete
1290: 22 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 ". } else {..
12a0: 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 6b 65 dputs "handshake
12b0: 3a 20 69 6e 20 70 72 6f 67 72 65 73 73 22 0a 20 : in progress".
12c0: 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 }.}..#.# Chec
12d0: 6b 20 69 66 20 77 65 27 72 65 20 73 75 70 70 6f k if we're suppo
12e0: 73 65 64 20 74 6f 20 64 6f 20 74 65 73 74 73 20 sed to do tests
12f0: 61 67 61 69 6e 73 74 20 74 68 65 20 72 65 6d 6f against the remo
1300: 74 65 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 te server.#..set
1310: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
1320: 74 65 53 65 72 76 65 72 20 31 0a 69 66 20 7b 21 teServer 1.if {!
1330: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
1340: 6f 74 65 53 65 72 76 65 72 49 50 5d 20 26 26 20 oteServerIP] &&
1350: 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 ($tcl_platform(p
1360: 6c 61 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 latform) != "mac
1370: 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 intosh")} {.
1380: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
1390: 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 IP 127.0.0.1.}.i
13a0: 66 20 7b 28 24 64 6f 54 65 73 74 73 57 69 74 68 f {($doTestsWith
13b0: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 RemoteServer ==
13c0: 31 29 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 1) && (![info ex
13d0: 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 ists remoteServe
13e0: 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 rPort])} {. s
13f0: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 et remoteServerP
1400: 6f 72 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f ort $tlsServerPo
1410: 72 74 0a 7d 0a 0a 23 20 41 74 74 65 6d 70 74 20 rt.}..# Attempt
1420: 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 61 20 to connect to a
1430: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 69 66 remote server if
1440: 20 6f 6e 65 20 69 73 20 61 6c 72 65 61 64 79 20 one is already
1450: 72 75 6e 6e 69 6e 67 2e 20 49 66 20 69 74 0a 23 running. If it.#
1460: 20 69 73 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 is not running
1470: 6f 72 20 66 6f 72 20 73 6f 6d 65 20 6f 74 68 65 or for some othe
1480: 72 20 72 65 61 73 6f 6e 20 74 68 65 20 63 6f 6e r reason the con
1490: 6e 65 63 74 20 66 61 69 6c 73 2c 20 61 74 74 65 nect fails, atte
14a0: 6d 70 74 20 74 6f 0a 23 20 73 74 61 72 74 20 74 mpt to.# start t
14b0: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
14c0: 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f on the local ho
14d0: 73 74 20 6c 69 73 74 65 6e 69 6e 67 20 6f 6e 20 st listening on
14e0: 70 6f 72 74 20 38 30 34 38 2e 20 54 68 69 73 0a port 8048. This.
14f0: 23 20 69 73 20 6f 6e 6c 79 20 64 6f 6e 65 20 6f # is only done o
1500: 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 n platforms that
1510: 20 73 75 70 70 6f 72 74 20 65 78 65 63 20 28 69 support exec (i
1520: 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 68 65 20 4d .e. not on the M
1530: 61 63 29 2e 20 4f 6e 0a 23 20 70 6c 61 74 66 6f ac). On.# platfo
1540: 72 6d 73 20 74 68 61 74 20 64 6f 20 6e 6f 74 20 rms that do not
1550: 73 75 70 70 6f 72 74 20 65 78 65 63 2c 20 74 68 support exec, th
1560: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 e remote server
1570: 6d 75 73 74 20 62 65 20 73 74 61 72 74 65 64 0a must be started.
1580: 23 20 62 79 20 74 68 65 20 75 73 65 72 20 62 65 # by the user be
1590: 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 fore running the
15a0: 20 74 65 73 74 73 2e 0a 0a 73 65 74 20 72 65 6d tests...set rem
15b0: 6f 74 65 50 72 6f 63 43 68 61 6e 20 22 22 0a 73 oteProcChan "".s
15c0: 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 et commandSocket
15d0: 20 22 22 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 "".if {$doTests
15e0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
15f0: 7d 20 7b 0a 20 20 20 20 63 61 74 63 68 20 7b 63 } {. catch {c
1600: 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 lose $commandSoc
1610: 6b 65 74 7d 0a 20 20 20 20 69 66 20 7b 5b 63 61 ket}. if {[ca
1620: 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 tch {set command
1630: 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 Socket [tls::soc
1640: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
1650: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
1660: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
1670: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
1680: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
1690: 6f 74 65 53 65 72 76 65 72 49 50 20 24 72 65 6d oteServerIP $rem
16a0: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d oteServerPort]}]
16b0: 20 21 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 != 0} {..if {[i
16c0: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 nfo commands exe
16d0: 63 5d 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 c] == ""} {..
16e0: 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 set noRemoteTes
16f0: 74 52 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 tReason "can't e
1700: 78 65 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f xec".. set do
1710: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1720: 65 72 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 erver 0..} else
1730: 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 {.. set remot
1740: 65 53 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e eServerIP 127.0.
1750: 30 2e 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 0.1.. set rem
1760: 6f 74 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f oteFile [file jo
1770: 69 6e 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e in [pwd] remote.
1780: 74 63 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 tcl].. if {[c
1790: 61 74 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 atch {set remote
17a0: 50 72 6f 63 43 68 61 6e 20 5c 0a 09 09 20 20 20 ProcChan \...
17b0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
17c0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
17d0: 73 74 20 24 72 65 6d 6f 74 65 46 69 6c 65 20 5c st $remoteFile \
17e0: 0a 09 09 20 20 20 20 2d 73 65 72 76 65 72 49 73 ... -serverIs
17f0: 53 69 6c 65 6e 74 20 2d 70 6f 72 74 20 24 72 65 Silent -port $re
1800: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 5c moteServerPort \
1810: 0a 09 09 20 20 20 20 2d 61 64 64 72 65 73 73 20 ... -address
1820: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d $remoteServerIP]
1830: 22 20 77 2b 5d 7d 20 6d 73 67 5d 20 3d 3d 20 30 " w+]} msg] == 0
1840: 7d 20 7b 0a 09 09 61 66 74 65 72 20 31 30 30 30 } {...after 1000
1850: 0a 09 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 ...if {[catch {s
1860: 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 et commandSocket
1870: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
1880: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
1890: 09 09 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c ...-certfile $cl
18a0: 69 65 6e 74 43 65 72 74 20 2d 6b 65 79 66 69 6c ientCert -keyfil
18b0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
18c0: 09 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 ..$remoteServerI
18d0: 50 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 P $remoteServerP
18e0: 6f 72 74 5d 7d 20 6d 73 67 5d 20 3d 3d 20 30 7d ort]} msg] == 0}
18f0: 20 7b 0a 09 09 20 20 20 20 66 63 6f 6e 66 69 67 {... fconfig
1900: 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ure $commandSock
1910: 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 et -translation
1920: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
1930: 6c 69 6e 65 0a 09 09 7d 20 65 6c 73 65 20 7b 0a line...} else {.
1940: 09 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f .. set noRemo
1950: 74 65 54 65 73 74 52 65 61 73 6f 6e 20 24 6d 73 teTestReason $ms
1960: 67 0a 09 09 20 20 20 20 73 65 74 20 64 6f 54 65 g... set doTe
1970: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1980: 76 65 72 20 30 0a 09 09 7d 0a 09 20 20 20 20 7d ver 0...}.. }
1990: 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 6e 6f else {...set no
19a0: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
19b0: 20 22 24 6d 73 67 20 24 3a 3a 74 63 6c 74 65 73 "$msg $::tcltes
19c0: 74 3a 3a 74 63 6c 74 65 73 74 22 0a 09 09 73 65 t::tcltest"...se
19d0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
19e0: 6f 74 65 53 65 72 76 65 72 20 30 0a 09 20 20 20 oteServer 0..
19f0: 20 7d 0a 09 7d 0a 20 20 20 20 7d 20 65 6c 73 65 }..}. } else
1a00: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
1a10: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 commandSocket -t
1a20: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 ranslation crlf
1a30: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
1a40: 20 20 20 20 7d 0a 7d 0a 0a 23 20 53 6f 6d 65 20 }.}..# Some
1a50: 74 65 73 74 73 20 61 72 65 20 72 75 6e 20 6f 6e tests are run on
1a60: 6c 79 20 69 66 20 77 65 20 61 72 65 20 64 6f 69 ly if we are doi
1a70: 6e 67 20 74 65 73 74 69 6e 67 20 61 67 61 69 6e ng testing again
1a80: 73 74 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 st a remote serv
1a90: 65 72 2e 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 er..set ::tcltes
1aa0: 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e t::testConstrain
1ab0: 74 73 28 64 6f 54 65 73 74 73 57 69 74 68 52 65 ts(doTestsWithRe
1ac0: 6d 6f 74 65 53 65 72 76 65 72 29 20 24 64 6f 54 moteServer) $doT
1ad0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1ae0: 72 76 65 72 0a 69 66 20 7b 24 64 6f 54 65 73 74 rver.if {$doTest
1af0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
1b00: 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 69 66 r == 0} {. if
1b10: 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 74 20 {[string first
1b20: 73 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 76 65 s $::tcltest::ve
1b30: 72 62 6f 73 65 5d 20 21 3d 20 2d 31 7d 20 7b 0a rbose] != -1} {.
1b40: 20 20 20 20 09 70 75 74 73 20 22 53 6b 69 70 70 .puts "Skipp
1b50: 69 6e 67 20 74 65 73 74 73 20 77 69 74 68 20 72 ing tests with r
1b60: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 20 53 65 emote server. Se
1b70: 65 20 74 65 73 74 73 2f 73 6f 63 6b 65 74 2e 74 e tests/socket.t
1b80: 65 73 74 20 66 6f 72 22 0a 09 70 75 74 73 20 22 est for"..puts "
1b90: 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 68 information on h
1ba0: 6f 77 20 74 6f 20 72 75 6e 20 72 65 6d 6f 74 65 ow to run remote
1bb0: 20 73 65 72 76 65 72 2e 22 0a 09 70 75 74 73 20 server."..puts
1bc0: 22 52 65 61 73 6f 6e 20 66 6f 72 20 6e 6f 74 20 "Reason for not
1bd0: 64 6f 69 6e 67 20 72 65 6d 6f 74 65 20 74 65 73 doing remote tes
1be0: 74 73 3a 20 24 6e 6f 52 65 6d 6f 74 65 54 65 73 ts: $noRemoteTes
1bf0: 74 52 65 61 73 6f 6e 22 0a 20 20 20 20 7d 0a 7d tReason". }.}
1c00: 0a 0a 23 0a 23 20 49 66 20 77 65 20 64 6f 20 74 ..#.# If we do t
1c10: 68 65 20 74 65 73 74 73 2c 20 64 65 66 69 6e 65 he tests, define
1c20: 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 73 65 a command to se
1c30: 6e 64 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 nd a command to
1c40: 74 68 65 0a 23 20 72 65 6d 6f 74 65 20 73 65 72 the.# remote ser
1c50: 76 65 72 2e 0a 23 0a 0a 69 66 20 7b 24 64 6f 54 ver..#..if {$doT
1c60: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1c70: 72 76 65 72 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 rver == 1} {.
1c80: 20 70 72 6f 63 20 73 65 6e 64 43 6f 6d 6d 61 6e proc sendComman
1c90: 64 20 7b 63 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 d {c} {..global
1ca0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 0a 09 commandSocket...
1cb0: 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e if {[eof $comman
1cc0: 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 20 20 20 dSocket]} {..
1cd0: 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 error "remote s
1ce0: 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 65 erver disappeare
1cf0: 64 22 0a 09 7d 0a 0a 09 69 66 20 7b 5b 63 61 74 d"..}...if {[cat
1d00: 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e ch {puts $comman
1d10: 64 53 6f 63 6b 65 74 20 24 63 7d 20 6d 73 67 5d dSocket $c} msg]
1d20: 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 } {.. error "
1d30: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 remote server di
1d40: 73 61 70 70 61 65 72 65 64 3a 20 24 6d 73 67 22 sappaered: $msg"
1d50: 0a 09 7d 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 ..}..if {[catch
1d60: 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f {puts $commandSo
1d70: 63 6b 65 74 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d cket "--Marker--
1d80: 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d Marker--Marker--
1d90: 22 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 "} msg]} {..
1da0: 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 error "remote se
1db0: 72 76 65 72 20 64 69 73 61 70 70 65 61 72 65 64 rver disappeared
1dc0: 3a 20 24 6d 73 67 22 0a 09 7d 0a 0a 09 73 65 74 : $msg"..}...set
1dd0: 20 72 65 73 70 20 22 22 0a 09 77 68 69 6c 65 20 resp ""..while
1de0: 7b 31 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {1} {.. set l
1df0: 69 6e 65 20 5b 67 65 74 73 20 24 63 6f 6d 6d 61 ine [gets $comma
1e00: 6e 64 53 6f 63 6b 65 74 5d 0a 09 20 20 20 20 69 ndSocket].. i
1e10: 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 f {[eof $command
1e20: 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 09 65 72 72 Socket]} {...err
1e30: 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 or "remote serve
1e40: 72 20 64 69 73 61 70 70 65 61 72 65 64 22 0a 09 r disappeared"..
1e50: 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 5b }.. if {[
1e60: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 24 string compare $
1e70: 6c 69 6e 65 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d line "--Marker--
1e80: 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d Marker--Marker--
1e90: 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 69 66 20 "] == 0} {...if
1ea0: 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 {[string compare
1eb0: 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 30 [lindex $resp 0
1ec0: 5d 20 65 72 72 6f 72 5d 20 3d 3d 20 30 7d 20 7b ] error] == 0} {
1ed0: 0a 09 09 20 20 20 20 65 72 72 6f 72 20 5b 6c 69 ... error [li
1ee0: 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 ndex $resp 1]...
1ef0: 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 72 } else {... r
1f00: 65 74 75 72 6e 20 5b 6c 69 6e 64 65 78 20 24 72 eturn [lindex $r
1f10: 65 73 70 20 31 5d 0a 09 09 7d 0a 09 20 20 20 20 esp 1]...}..
1f20: 7d 20 65 6c 73 65 20 7b 0a 09 09 61 70 70 65 6e } else {...appen
1f30: 64 20 72 65 73 70 20 24 6c 69 6e 65 20 22 5c 6e d resp $line "\n
1f40: 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 ".. }..}.
1f50: 7d 0a 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }.. sendComma
1f60: 6e 64 20 5b 6c 69 73 74 20 70 72 6f 63 20 64 70 nd [list proc dp
1f70: 75 74 73 20 5b 69 6e 66 6f 20 61 72 67 73 20 64 uts [info args d
1f80: 70 75 74 73 5d 20 5b 69 6e 66 6f 20 62 6f 64 79 puts] [info body
1f90: 20 64 70 75 74 73 5d 5d 0a 0a 20 20 20 20 70 72 dputs]].. pr
1fa0: 6f 63 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 oc sendCertValue
1fb0: 73 20 7b 7d 20 7b 0a 09 23 20 57 65 20 6e 65 65 s {} {..# We nee
1fc0: 64 20 74 6f 20 62 65 20 61 62 6c 65 20 74 6f 20 d to be able to
1fd0: 73 65 6e 64 20 63 65 72 74 69 66 69 63 61 74 65 send certificate
1fe0: 20 76 61 6c 75 65 73 20 74 68 61 74 20 6e 6f 72 values that nor
1ff0: 6d 61 6c 69 7a 65 0a 09 23 20 66 69 6c 65 6e 61 malize..# filena
2000: 6d 65 73 20 61 63 72 6f 73 73 20 70 6c 61 74 66 mes across platf
2010: 6f 72 6d 73 0a 09 73 65 6e 64 43 6f 6d 6d 61 6e orms..sendComman
2020: 64 20 7b 0a 09 20 20 20 20 73 65 74 20 63 65 72 d {.. set cer
2030: 74 73 44 69 72 09 5b 66 69 6c 65 20 6a 6f 69 6e tsDir.[file join
2040: 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 5b [file dirname [
2050: 69 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 63 65 info script]] ce
2060: 72 74 73 5d 0a 09 20 20 20 20 73 65 74 20 73 65 rts].. set se
2070: 72 76 65 72 43 65 72 74 09 5b 66 69 6c 65 20 6a rverCert.[file j
2080: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 65 oin $certsDir se
2090: 72 76 65 72 2e 70 65 6d 5d 0a 09 20 20 20 20 73 rver.pem].. s
20a0: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 09 5b 66 et clientCert.[f
20b0: 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 ile join $certsD
20c0: 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 09 ir client.pem]..
20d0: 20 20 20 20 73 65 74 20 63 61 43 65 72 74 09 09 set caCert..
20e0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
20f0: 73 44 69 72 20 63 61 63 65 72 74 2e 70 65 6d 5d sDir cacert.pem]
2100: 0a 09 20 20 20 20 73 65 74 20 73 65 72 76 65 72 .. set server
2110: 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 Key.[file join $
2120: 63 65 72 74 73 44 69 72 20 73 6b 65 79 2e 70 65 certsDir skey.pe
2130: 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 6c 69 65 m].. set clie
2140: 6e 74 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e ntKey.[file join
2150: 20 24 63 65 72 74 73 44 69 72 20 63 6b 65 79 2e $certsDir ckey.
2160: 70 65 6d 5d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a pem]..}. }.}.
2170: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 .test tlsIO-1.1
2180: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2190: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
21a0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
21b0: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
21c0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
21d0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
21e0: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
21f0: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2200: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 socket -server c
2210: 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f ommand ?options?
2220: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
2230: 6c 73 49 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 lsIO-1.2 {arg pa
2240: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2250: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2260: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2270: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2280: 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d t -server foo} m
2290: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
22a0: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
22b0: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
22c0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
22d0: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
22e0: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
22f0: 4f 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 O-1.3 {arg parsi
2300: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2310: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
2320: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
2330: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2340: 6d 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 myaddr} msg] $ms
2350: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
2360: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
2370: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
2380: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
2390: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
23a0: 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.4 {arg parsing
23b0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
23c0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
23d0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
23e0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
23f0: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 addr 127.0.0.1}
2400: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
2410: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
2420: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
2430: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
2440: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
2450: 74 20 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 t tlsIO-1.5 {arg
2460: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2470: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2480: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2490: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
24a0: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 cket -myport} ms
24b0: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
24c0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
24d0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
24e0: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
24f0: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
2500: 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 72 67 20 70 tlsIO-1.6 {arg p
2510: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2520: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2530: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
2540: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
2550: 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d et -myport xxxx}
2560: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
2570: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
2580: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
2590: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
25a0: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
25b0: 73 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 72 st tlsIO-1.7 {ar
25c0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
25d0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
25e0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
25f0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2600: 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 ocket -myport 25
2610: 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 22} msg] $msg.}
2620: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
2630: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
2640: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
2650: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
2660: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 38 20 .test tlsIO-1.8
2670: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2680: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2690: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
26a0: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
26b0: 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a ::socket -froboz
26c0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
26d0: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
26e0: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
26f0: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
2700: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2710: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 39 20 7b 61 est tlsIO-1.9 {a
2720: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2730: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2740: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2750: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2760: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 66 socket -server f
2770: 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 35 32 31 20 oo -myport 2521
2780: 33 33 33 33 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 3333} msg] $msg.
2790: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
27a0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
27b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
27c0: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 er command ?opti
27d0: 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 ons? port"}}..te
27e0: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 st tlsIO-1.10 {a
27f0: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2800: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2810: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2820: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2830: 73 6f 63 6b 65 74 20 68 6f 73 74 20 32 35 32 38 socket host 2528
2840: 20 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 -junk} msg] $ms
2850: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
2860: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
2870: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
2880: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
2890: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
28a0: 31 2e 31 31 20 7b 61 72 67 20 70 61 72 73 69 6e 1.11 {arg parsin
28b0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
28c0: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
28d0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
28e0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
28f0: 65 72 76 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 erver callback 2
2900: 35 32 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 520 --} msg] $ms
2910: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
2920: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
2930: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
2940: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
2950: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
2960: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 test tlsIO-1.12
2970: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2980: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2990: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
29a0: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
29b0: 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 ::socket foo bad
29c0: 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a port} msg] $msg.
29d0: 7d 20 7b 31 20 7b 65 78 70 65 63 74 65 64 20 69 } {1 {expected i
29e0: 6e 74 65 67 65 72 20 62 75 74 20 67 6f 74 20 22 nteger but got "
29f0: 62 61 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 badport"}}..test
2a00: 20 74 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 70 20 tlsIO-2.1 {tcp
2a10: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
2a20: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
2a30: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
2a40: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
2a50: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
2a60: 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 puts $f {..set
2a70: 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 auto_path [linse
2a80: 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 20 rt $auto_path 0
2a90: 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 [lindex [split $
2aa0: 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 env(PATH) ";:"]
2ab0: 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 71 0]]..package req
2ac0: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
2ad0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
2ae0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
2af0: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
2b00: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
2b10: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2b20: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
2b30: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
2b40: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
2b50: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
2b60: 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 ey 8828 \]".
2b70: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
2b80: 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 accept {file add
2b90: 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 r port} {.. g
2ba0: 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 lobal x.. set
2bb0: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
2bc0: 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a close $file.
2bd0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
2be0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
2bf0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
2c00: 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a ose $f..puts $x.
2c10: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
2c20: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
2c30: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
2c40: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
2c50: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
2c60: 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 ets $f x. if
2c70: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
2c80: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
2c90: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
2ca0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
2cb0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
2cc0: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 y 127.0.0.1 8828
2cd0: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
2ce0: 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 set x $msg.
2cf0: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
2d00: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
2d10: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
2d20: 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ose $msg. }.
2d30: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
2d40: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
2d50: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
2d60: 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a {ready done {}}.
2d70: 0a 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 .if [info exists
2d80: 20 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 port] {. inc
2d90: 72 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 20 r port.} else {
2da0: 0a 20 20 20 20 73 65 74 20 70 6f 72 74 20 5b 65 . set port [e
2db0: 78 70 72 20 24 74 6c 73 53 65 72 76 65 72 50 6f xpr $tlsServerPo
2dc0: 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d rt + [pid]%1024]
2dd0: 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 .}..test tlsIO-2
2de0: 2e 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .2 {tcp connecti
2df0: 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 on with client p
2e00: 6f 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b ort specified} {
2e10: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
2e20: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
2e30: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
2e40: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
2e50: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 puts $f {..s
2e60: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 et auto_path [li
2e70: 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 nsert $auto_path
2e80: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 0 [lindex [spli
2e90: 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a t $env(PATH) ";:
2ea0: 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 "] 0]]..package
2eb0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
2ec0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
2ed0: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
2ee0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
2ef0: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
2f00: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2f10: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
2f20: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
2f30: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
2f40: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
2f50: 20 38 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 8829 \]". pu
2f60: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
2f70: 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 cept {sock addr
2f80: 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 port} {.
2f90: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
2fa0: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b puts "[
2fb0: 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 70 6f 72 gets $sock] $por
2fc0: 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 t". c
2fd0: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 lose $sock.
2fe0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
2ff0: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
3000: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
3010: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
3020: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 close $f. }.
3030: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3040: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
3050: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
3060: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
3070: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 r]. gets $f
3080: 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 x. global por
3090: 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 t. if {[catch
30a0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
30b0: 79 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a 09 2d yport $port \..-
30c0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
30d0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
30e0: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
30f0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
3100: 30 2e 30 2e 31 20 38 38 32 39 7d 20 73 6f 63 6b 0.0.1 8829} sock
3110: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
3120: 20 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 x $sock..catch
3130: 7b 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 {close [tls::soc
3140: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 ket 127.0.0.1 88
3150: 32 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 29]}. } else
3160: 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 {. puts $
3170: 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 sock hello..flus
3180: 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 h $sock.
3190: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
31a0: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
31b0: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
31c0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
31d0: 65 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 61 et x.} [list rea
31e0: 64 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 22 dy "hello $port"
31f0: 5d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e ]..test tlsIO-2.
3200: 33 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 3 {tcp connectio
3210: 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 69 6e n with client in
3220: 74 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 terface specifie
3230: 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f d} {socket stdio
3240: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
3250: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
3260: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3270: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3280: 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 {..set auto_path
3290: 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f [linsert $auto_
32a0: 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b path 0 [lindex [
32b0: 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 split $env(PATH)
32c0: 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b ";:"] 0]]..pack
32d0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
32e0: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
32f0: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f r 2000 "set x do
3300: 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ne"]. }. p
3310: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3320: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3330: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
3340: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
3350: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3360: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
3370: 72 4b 65 79 20 38 38 33 30 20 5c 5d 22 0a 20 20 rKey 8830 \]".
3380: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
3390: 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 c accept {sock a
33a0: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 ddr port} {.
33b0: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
33c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
33d0: 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 s "[gets $sock]
33e0: 24 61 64 64 72 22 0a 20 20 20 20 20 20 20 20 20 $addr".
33f0: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
3400: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
3410: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
3420: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
3430: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
3440: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 er..close $f.
3450: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3460: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3470: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
3480: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
3490: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
34a0: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
34b0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
34c0: 74 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e t -myaddr 127.0.
34d0: 30 2e 31 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 0.1 \..-certfile
34e0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
34f0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
3500: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3510: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
3520: 33 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 30} sock]} {.
3530: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
3540: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
3550: 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b puts $sock
3560: 20 68 65 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 hello..catch {f
3570: 6c 75 73 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 lush $sock}.
3580: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
3590: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
35a0: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
35b0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
35c0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
35d0: 79 20 7b 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 y {hello 127.0.0
35e0: 2e 31 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f .1}}..test tlsIO
35f0: 2d 32 2e 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.4 {tcp connec
3600: 74 69 6f 6e 20 77 69 74 68 20 73 65 72 76 65 72 tion with server
3610: 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 interface speci
3620: 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 fied} {socket st
3630: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
3640: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
3650: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
3660: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
3670: 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 $f {..set auto_p
3680: 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 ath [linsert $au
3690: 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 to_path 0 [linde
36a0: 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 x [split $env(PA
36b0: 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 TH) ";:"] 0]]..p
36c0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
36d0: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
36e0: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
36f0: 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 done"]. }.
3700: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
3710: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
3720: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
3730: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
3740: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
3750: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
3760: 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 rverKey -myaddr
3770: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
3780: 38 38 33 31 20 5c 5d 22 0a 20 20 20 20 70 75 74 8831 \]". put
3790: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
37a0: 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 ept {sock addr p
37b0: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
37c0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
37d0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
37e0: 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 20 20 ets $sock]".
37f0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3800: 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 ock.
3810: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
3820: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3830: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3840: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3850: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
3860: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3870: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3880: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3890: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
38a0: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
38b0: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
38c0: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
38d0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
38e0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
38f0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3900: 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 Key [info hostna
3910: 6d 65 5d 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d me] 8831} sock]}
3920: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
3930: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 $sock. } els
3940: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
3950: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c $sock hello..fl
3960: 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ush $sock.
3970: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
3980: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
3990: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
39a0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
39b0: 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 set x.} {ready
39c0: 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 hello}..test tls
39d0: 49 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e IO-2.5 {tcp conn
39e0: 65 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 ection with redu
39f0: 6e 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 ndant server por
3a00: 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f t} {socket stdio
3a10: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
3a20: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
3a30: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3a40: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3a50: 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 {..set auto_path
3a60: 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f [linsert $auto_
3a70: 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b path 0 [lindex [
3a80: 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 split $env(PATH)
3a90: 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b ";:"] 0]]..pack
3aa0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
3ab0: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
3ac0: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f r 2000 "set x do
3ad0: 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ne"]. }. p
3ae0: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3af0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3b00: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
3b10: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
3b20: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3b30: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
3b40: 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 0a 20 20 rKey 8832 \]".
3b50: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
3b60: 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 c accept {sock a
3b70: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 ddr port} {.
3b80: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
3b90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
3ba0: 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 22 s "[gets $sock]"
3bb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
3bc0: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 se $sock.
3bd0: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
3be0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
3bf0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
3c00: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
3c10: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
3c20: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
3c30: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
3c40: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
3c50: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
3c60: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
3c70: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
3c80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
3c90: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
3ca0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3cb0: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
3cc0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
3cd0: 2e 31 20 38 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 .1 8832} sock]}
3ce0: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
3cf0: 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 $sock. } else
3d00: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
3d10: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
3d20: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
3d30: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
3d40: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
3d50: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
3d60: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3d70: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 set x.} {ready h
3d80: 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 6c 73 49 4f ello}.test tlsIO
3d90: 2d 32 2e 36 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.6 {tcp connec
3da0: 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b tion} {socket} {
3db0: 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 . set status
3dc0: 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 ok. if {![cat
3dd0: 63 68 20 7b 73 65 74 20 73 6f 63 6b 20 5b 74 6c ch {set sock [tl
3de0: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
3df0: 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 20 7b 0a 09 0.1 8833]}]} {..
3e00: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 if {![catch {get
3e10: 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 s $sock}]} {..
3e20: 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f set status bro
3e30: 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 ken..}..close $s
3e40: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ock. }. se
3e50: 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 t status.} ok..t
3e60: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 37 20 7b 65 est tlsIO-2.7 {e
3e70: 63 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 cho server, one
3e80: 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 line} {socket st
3e90: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
3ea0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
3eb0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
3ec0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
3ed0: 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 $f {..set auto_p
3ee0: 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 ath [linsert $au
3ef0: 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 to_path 0 [linde
3f00: 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 x [split $env(PA
3f10: 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 TH) ";:"] 0]]..p
3f20: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
3f30: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
3f40: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
3f50: 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 done"]. }.
3f60: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
3f70: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
3f80: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
3f90: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
3fa0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
3fb0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
3fc0: 72 76 65 72 4b 65 79 20 38 38 33 34 20 5c 5d 22 rverKey 8834 \]"
3fd0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
3fe0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
3ff0: 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 p} {.
4000: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
4010: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
4020: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
4030: 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 figure $s -trans
4040: 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 lation lf -buffe
4050: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 ring line.
4060: 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b }..proc echo {
4070: 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 20 6c s} {.. set l
4080: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 [gets $s].
4090: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 if {[eof
40a0: 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 $s]} {.
40b0: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
40c0: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
40d0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
40e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
40f0: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
4100: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 } else {.
4110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 p
4120: 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 uts $s $l.
4130: 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 }..}..put
4140: 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 s ready..vwait x
4150: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
4160: 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a timer..close $f.
4170: 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 20 7d .puts done. }
4180: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
4190: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
41a0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
41b0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
41c0: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
41d0: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
41e0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
41f0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
4200: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4210: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
4220: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
4230: 38 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8834]. fconfi
4240: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
4250: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
4260: 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 74 73 tion lf. puts
4270: 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 $s "hello abcde
4280: 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 fghijklmnop".
4290: 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 after 1000.
42a0: 73 65 74 20 78 20 5b 67 65 74 73 20 24 73 5d 0a set x [gets $s].
42b0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
42c0: 20 73 65 74 20 79 20 5b 67 65 74 73 20 24 66 5d set y [gets $f]
42d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
42e0: 20 20 6c 69 73 74 20 24 78 20 24 79 0a 7d 20 7b list $x $y.} {
42f0: 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 {hello abcdefghi
4300: 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a jklmnop} done}..
4310: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 38 20 7b test tlsIO-2.8 {
4320: 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f echo server, loo
4330: 70 20 35 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 p 50 times, sing
4340: 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b le connection} {
4350: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
4360: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
4370: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
4380: 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 ts $f {..set aut
4390: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
43a0: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
43b0: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
43c0: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
43d0: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
43e0: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
43f0: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
4400: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
4410: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4420: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
4430: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
4440: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
4450: 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 20 5c serverKey 8835 \
4460: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
4470: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
4480: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
4490: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
44a0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
44b0: 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 echo $s].
44c0: 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 fconfigure
44d0: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
44e0: 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 ne. }..pr
44f0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
4500: 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 global i.
4510: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 set l
4520: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
4530: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
4540: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
4550: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
4560: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4570: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
4580: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
4590: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
45a0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 } else { ..
45b0: 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 incr i.
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 puts $s $l.
45e0: 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 }..}..se
45f0: 74 20 69 20 30 0a 09 70 75 74 73 20 72 65 61 64 t i 0..puts read
4600: 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 y..set timer [af
4610: 74 65 72 20 32 30 30 30 30 20 22 73 65 74 20 78 ter 20000 "set x
4620: 20 64 6f 6e 65 22 5d 0a 09 76 77 61 69 74 20 78 done"]..vwait x
4630: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
4640: 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a timer..close $f.
4650: 09 70 75 74 73 20 22 64 6f 6e 65 20 24 69 22 0a .puts "done $i".
4660: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
4670: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
4680: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
4690: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
46a0: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
46b0: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 ets $f. set s
46c0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
46d0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
46e0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
46f0: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4700: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
4710: 2e 30 2e 31 20 38 38 33 35 5d 0a 20 20 20 20 66 .0.1 8835]. f
4720: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
4730: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
4740: 20 63 61 74 63 68 20 7b 0a 09 66 6f 72 20 7b 73 catch {..for {s
4750: 65 74 20 78 20 30 7d 20 7b 24 78 20 3c 20 35 30 et x 0} {$x < 50
4760: 7d 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 20 20 } {incr x} {..
4770: 20 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f puts $s "hello
4780: 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f abcdefghijklmno
4790: 70 22 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a p".. gets $s.
47a0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f .}. }. clo
47b0: 73 65 20 24 73 0a 20 20 20 20 63 61 74 63 68 20 se $s. catch
47c0: 7b 73 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d {set x [gets $f]
47d0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
47e0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 64 6f 6e 65 set x.} {done
47f0: 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 50}..test tlsIO
4800: 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20 63 6f 6e -2.9 {socket con
4810: 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 flict} {socket s
4820: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 tdio} {. set
4830: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
4840: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
4850: 32 38 5d 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 28]. removeFi
4860: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
4870: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
4880: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f w]. puts -no
4890: 6e 65 77 6c 69 6e 65 20 24 66 20 7b 0a 09 73 65 newline $f {..se
48a0: 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e t auto_path [lin
48b0: 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 sert $auto_path
48c0: 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 0 [lindex [split
48d0: 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 $env(PATH) ";:"
48e0: 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 ] 0]]..package r
48f0: 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a equire tls..tls:
4900: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4910: 61 63 63 65 70 74 20 38 38 32 38 0a 20 20 20 20 accept 8828.
4920: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
4930: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
4940: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
4950: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
4960: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
4970: 24 66 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 $f. after 100
4980: 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 . set x [list
4990: 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 [catch {close $
49a0: 66 7d 20 6d 73 67 5d 20 5b 73 74 72 69 6e 67 20 f} msg] [string
49b0: 72 61 6e 67 65 20 24 6d 73 67 20 30 20 34 33 5d range $msg 0 43]
49c0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
49d0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 set x.} {1 {c
49e0: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
49f0: 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 ket: address alr
4a00: 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 eady in use}}..t
4a10: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 30 20 7b est tlsIO-2.10 {
4a20: 63 6c 6f 73 65 20 6f 6e 20 61 63 63 65 70 74 2c close on accept,
4a30: 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 accepted socket
4a40: 20 6c 69 76 65 73 7d 20 7b 73 6f 63 6b 65 74 7d lives} {socket}
4a50: 20 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 {. set done
4a60: 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 0. set timer
4a70: 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 [after 20000 "se
4a80: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
4a90: 22 5d 0a 20 20 20 20 73 65 74 20 73 73 20 5b 74 "]. set ss [t
4aa0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4ab0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
4ac0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
4ad0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4ae0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 \..-keyfile $ser
4af0: 76 65 72 4b 65 79 20 38 38 33 30 5d 0a 20 20 20 verKey 8830].
4b00: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
4b10: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 a p} {..global s
4b20: 73 0a 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 s..close $ss..fi
4b30: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
4b40: 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a ble "readit $s".
4b50: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
4b60: 74 72 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 trans lf. }.
4b70: 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b proc readit {
4b80: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e s} {..global don
4b90: 65 0a 09 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 e..gets $s..clos
4ba0: 65 20 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 e $s..set done 1
4bb0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 . }. set c
4bc0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
4bd0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
4be0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4bf0: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
4c00: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 $clientKey [inf
4c10: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 30 o hostname] 8830
4c20: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a ]. close $cs.
4c30: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
4c40: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
4c50: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 20 $timer. set
4c60: 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 74 done.} 1..test t
4c70: 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 65 74 65 63 lsIO-2.11 {detec
4c80: 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 7b ting new data} {
4c90: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 70 72 socket} {. pr
4ca0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
4cb0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 6b } {..global sock
4cc0: 0a 09 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 ..# when doing a
4cd0: 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 n in-process cli
4ce0: 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c ent/server test,
4cf0: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 both sides need
4d00: 0a 09 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c ..# to be non-bl
4d10: 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 ocking for the T
4d20: 4c 53 20 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 LS handshake. A
4d30: 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 lso make sure..#
4d40: 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 20 63 to return the c
4d50: 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 hannel to line b
4d60: 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 uffering mode...
4d70: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
4d80: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
4d90: 72 69 6e 67 20 6c 69 6e 65 0a 09 73 65 74 20 73 ring line..set s
4da0: 6f 63 6b 20 24 73 0a 09 66 69 6c 65 65 76 65 6e ock $s..fileeven
4db0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
4dc0: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
4dd0: 20 24 73 5d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 $s]. }..
4de0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
4df0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4e00: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
4e10: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
4e20: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
4e30: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
4e40: 65 79 20 38 34 30 30 5d 0a 20 20 20 20 73 65 74 ey 8400]. set
4e50: 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 65 74 sock "". set
4e60: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
4e70: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4e80: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4e90: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4ea0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
4eb0: 37 2e 30 2e 30 2e 31 20 38 34 30 30 5d 0a 20 20 7.0.0.1 8400].
4ec0: 20 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 # when doing a
4ed0: 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 n in-process cli
4ee0: 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c ent/server test,
4ef0: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 both sides need
4f00: 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e . # to be non
4f10: 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 -blocking for th
4f20: 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 e TLS handshake
4f30: 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 Also make sure
4f40: 74 6f 0a 20 20 20 20 23 20 72 65 74 75 72 6e 20 to. # return
4f50: 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c the channel to l
4f60: 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f ine buffering mo
4f70: 64 65 20 28 54 4c 53 20 73 65 74 73 20 69 74 20 de (TLS sets it
4f80: 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 to 'none')..
4f90: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d fconfigure $s2 -
4fa0: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 blocking 0 -buff
4fb0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 ering line. v
4fc0: 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 wait sock. pu
4fd0: 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 ts $s2 one. f
4fe0: 6c 75 73 68 20 24 73 32 0a 20 20 20 20 23 20 6e lush $s2. # n
4ff0: 65 65 64 20 75 70 64 61 74 65 20 74 6f 20 63 6f eed update to co
5000: 6d 70 6c 65 74 65 20 54 4c 53 20 68 61 6e 64 73 mplete TLS hands
5010: 68 61 6b 65 20 69 6e 2d 70 72 6f 63 65 73 73 0a hake in-process.
5020: 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 61 update. a
5030: 66 74 65 72 20 35 30 30 0a 20 20 20 20 66 63 6f fter 500. fco
5040: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 nfigure $sock -b
5050: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 65 locking 0. se
5060: 74 20 72 65 73 75 6c 74 20 61 3a 5b 67 65 74 73 t result a:[gets
5070: 20 24 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70 $sock]. lapp
5080: 65 6e 64 20 72 65 73 75 6c 74 20 62 3a 5b 67 65 end result b:[ge
5090: 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 ts $sock]. fc
50a0: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
50b0: 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 70 blocking 1. p
50c0: 75 74 73 20 24 73 32 20 74 77 6f 0a 20 20 20 20 uts $s2 two.
50d0: 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 66 63 flush $s2. fc
50e0: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
50f0: 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 6c blocking 0. l
5100: 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 63 3a append result c:
5110: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
5120: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
5130: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 k -blocking 1.
5140: 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 close $s2.
5150: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
5160: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 se $sock. set
5170: 20 72 65 73 75 6c 74 0a 7d 20 7b 61 3a 6f 6e 65 result.} {a:one
5180: 20 62 3a 20 63 3a 74 77 6f 7d 0a 0a 74 65 73 74 b: c:two}..test
5190: 20 74 6c 73 49 4f 2d 32 2e 31 32 20 7b 74 63 70 tlsIO-2.12 {tcp
51a0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 connection; no
51b0: 63 65 72 74 69 66 69 63 61 74 65 73 20 73 70 65 certificates spe
51c0: 63 69 66 69 65 64 7d 20 5c 0a 09 7b 73 6f 63 6b cified} \..{sock
51d0: 65 74 20 73 74 64 69 6f 20 75 6e 69 78 4f 6e 6c et stdio unixOnl
51e0: 79 7d 20 7b 0a 20 20 20 20 23 20 54 68 65 72 65 y} {. # There
51f0: 20 69 73 20 61 20 64 65 62 75 67 20 61 73 73 65 is a debug asse
5200: 72 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 6f 77 73 rtion on Windows
5210: 2f 53 53 4c 20 74 68 61 74 20 63 61 75 73 65 73 /SSL that causes
5220: 20 61 20 63 72 61 73 68 20 77 68 65 6e 20 74 68 a crash when th
5230: 65 0a 20 20 20 20 23 20 63 65 72 74 69 66 69 63 e. # certific
5240: 61 74 65 20 69 73 6e 27 74 20 73 70 65 63 69 66 ate isn't specif
5250: 69 65 64 2e 0a 20 20 20 20 72 65 6d 6f 76 65 46 ied.. removeF
5260: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
5270: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
5280: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
5290: 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f 70 61 74 {..set auto_pat
52a0: 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 75 74 6f h [linsert $auto
52b0: 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 _path 0 [lindex
52c0: 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 41 54 48 [split $env(PATH
52d0: 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 ) ";:"] 0]]..pac
52e0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
52f0: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
5300: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 74 er 2000 "set x t
5310: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 imed_out"]..set
5320: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
5330: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
5340: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
5350: 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 {file addr port
5360: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
5370: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
5380: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c e. cl
5390: 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 ose $file..}..pu
53a0: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
53b0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
53c0: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
53d0: 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a ..puts $x. }.
53e0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
53f0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
5400: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5410: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5420: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
5430: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
5440: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 h {tls::socket 1
5450: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 27.0.0.1 8828} m
5460: 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 sg]} {. s
5470: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
5480: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c else {. l
5490: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
54a0: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
54b0: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
54c0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
54d0: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
54e0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
54f0: 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 ady done {}}..te
5500: 73 74 20 74 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f st tlsIO-3.1 {so
5510: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b cket conflict} {
5520: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
5530: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
5540: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
5550: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
5560: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 puts $f {..s
5570: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 et auto_path [li
5580: 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 nsert $auto_path
5590: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 0 [lindex [spli
55a0: 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a t $env(PATH) ";:
55b0: 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 "] 0]]..package
55c0: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
55d0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
55e0: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
55f0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
5600: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
5610: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
5620: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5630: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 $serverKey 8828
5640: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
5650: 20 7b 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 {..puts ready..
5660: 67 65 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 gets stdin..clos
5670: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
5680: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
5690: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
56a0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
56b0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
56c0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
56d0: 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 set x [list [ca
56e0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
56f0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
5700: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
5710: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
5720: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
5730: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
5740: 20 61 63 63 65 70 74 20 38 38 32 38 7d 20 6d 73 accept 8828} ms
5750: 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 g] \...$msg].
5760: 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 puts $f bye.
5770: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
5780: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
5790: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
57a0: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
57b0: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 in use}}..test t
57c0: 6c 73 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 lsIO-3.2 {server
57d0: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
57e0: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
57f0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
5800: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
5810: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
5820: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
5830: 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f $f {..set auto_
5840: 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 path [linsert $a
5850: 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 uto_path 0 [lind
5860: 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 ex [split $env(P
5870: 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 ATH) ";:"] 0]]..
5880: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
5890: 74 6c 73 0a 09 73 65 74 20 74 31 20 5b 61 66 74 tls..set t1 [aft
58a0: 65 72 20 33 30 30 30 30 20 22 73 65 74 20 78 20 er 30000 "set x
58b0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 timed_out"]..set
58c0: 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 t2 [after 31000
58d0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
58e0: 74 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 66 74 t"]..set t3 [aft
58f0: 65 72 20 33 32 30 30 30 20 22 73 65 74 20 78 20 er 32000 "set x
5900: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 timed_out"]..set
5910: 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 7d counter 0. }
5920: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
5930: 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s \[tls::socke
5940: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
5950: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
5960: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
5970: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5980: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 $serverKey 8828
5990: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
59a0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
59b0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 s a p} {.. fi
59c0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
59d0: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
59e0: 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 s].. fconfigu
59f0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
5a00: 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 65 line..}..proc e
5a10: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 cho {s} {..
5a20: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
5a30: 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 set l [get
5a40: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 s $s].
5a50: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
5a60: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
5a70: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
5a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
5a90: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
5aa0: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 } else {.
5ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ac0: 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 puts $s $l.
5ad0: 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 }..}..pu
5ae0: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
5af0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
5b00: 24 74 31 0a 09 76 77 61 69 74 20 78 0a 09 61 66 $t1..vwait x..af
5b10: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 09 ter cancel $t2..
5b20: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
5b30: 61 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f 73 65 ancel $t3..close
5b40: 20 24 73 0a 09 70 75 74 73 20 24 78 0a 20 20 20 $s..puts $x.
5b50: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
5b60: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
5b70: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
5b80: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
5b90: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 73 65 74 pt]" r+]. set
5ba0: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
5bb0: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
5bc0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
5bd0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
5be0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5bf0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
5c00: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
5c10: 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 .0.0.1 8828].
5c20: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 fconfigure $s1
5c30: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
5c40: 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a set s2 [tls:
5c50: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
5c60: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
5c70: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
5c80: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
5c90: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
5ca0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 127.0.0.1 8828].
5cb0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
5cc0: 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s2 -buffering li
5cd0: 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 ne. set s3 [t
5ce0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
5cf0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
5d00: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
5d10: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5d20: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
5d30: 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 127.0.0.1 882
5d40: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
5d50: 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 e $s3 -buffering
5d60: 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 line. for {s
5d70: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 et i 0} {$i < 10
5d80: 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 0} {incr i} {..p
5d90: 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 uts $s1 hello,s1
5da0: 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 ..gets $s1..puts
5db0: 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 $s2 hello,s2..g
5dc0: 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 ets $s2..puts $s
5dd0: 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 3 hello,s3..gets
5de0: 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 $s3. }. c
5df0: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f lose $s1. clo
5e00: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
5e10: 20 24 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 $s3. lappend
5e20: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
5e30: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
5e40: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e t x.} {ready don
5e50: 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 e}..test tlsIO-4
5e60: 2e 31 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 .1 {server with
5e70: 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d several clients}
5e80: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
5e90: 7b 0a 20 20 20 20 23 20 68 61 76 65 20 73 65 65 {. # have see
5ea0: 6e 20 69 6e 74 65 72 6d 69 74 74 65 6e 74 20 68 n intermittent h
5eb0: 61 6e 67 73 20 6f 6e 20 57 69 6e 64 6f 77 73 0a angs on Windows.
5ec0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
5ed0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
5ee0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
5ef0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 puts $f {..s
5f00: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 et auto_path [li
5f10: 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 nsert $auto_path
5f20: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 0 [lindex [spli
5f30: 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a t $env(PATH) ";:
5f40: 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 "] 0]]..package
5f50: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 require tls..get
5f60: 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 s stdin. }.
5f70: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 73 puts $f "set s
5f80: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
5f90: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
5fa0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
5fb0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
5fc0: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
5fd0: 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 .1 8828 \]".
5fe0: 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e 66 puts $f {..fconf
5ff0: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
6000: 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 7b 73 ing line..for {s
6010: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 et i 0} {$i < 10
6020: 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 0} {incr i} {..
6030: 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f puts $s hello
6040: 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d .. gets $s..}
6050: 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 ..close $s..puts
6060: 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 69 6e bye..gets stdin
6070: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
6080: 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 20 5b $f. set p1 [
6090: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
60a0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
60b0: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
60c0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 31 fconfigure $p1
60d0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
60e0: 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f 70 65 . set p2 [ope
60f0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
6100: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
6110: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 ript]" r+]. f
6120: 63 6f 6e 66 69 67 75 72 65 20 24 70 32 20 2d 62 configure $p2 -b
6130: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
6140: 20 20 73 65 74 20 70 33 20 5b 6f 70 65 6e 20 22 set p3 [open "
6150: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
6160: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
6170: 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e t]" r+]. fcon
6180: 66 69 67 75 72 65 20 24 70 33 20 2d 62 75 66 66 figure $p3 -buff
6190: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 ering line. p
61a0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
61b0: 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 p} {..fconfigure
61c0: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
61d0: 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 ine..fileevent $
61e0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
61f0: 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 7d 0a echo $s]. }.
6200: 20 20 20 20 70 72 6f 63 20 65 63 68 6f 20 7b 73 proc echo {s
6210: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 20 20 } {..global x.
6220: 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 set l [get
6230: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 69 66 s $s]. if
6240: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
6250: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
6260: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 $s. s
6270: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
6280: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
6290: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 puts $s $
62a0: 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 l. }.
62b0: 7d 0a 20 20 20 20 73 65 74 20 74 31 20 5b 61 66 }. set t1 [af
62c0: 74 65 72 20 33 30 30 30 30 20 22 73 65 74 20 78 ter 30000 "set x
62d0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
62e0: 20 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 set t2 [after 3
62f0: 31 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 1000 "set x time
6300: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 d_out"]. set
6310: 74 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 t3 [after 32000
6320: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
6330: 22 5d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c "]. set s [tl
6340: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
6350: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
6360: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
6370: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6380: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
6390: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
63a0: 20 38 38 32 38 5d 0a 20 20 20 20 70 75 74 73 20 8828]. puts
63b0: 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 $p1 open. put
63c0: 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 s $p2 open. p
63d0: 75 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 uts $p3 open.
63e0: 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 vwait x. vwa
63f0: 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 it x. vwait x
6400: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
6410: 6c 20 24 74 31 0a 20 20 20 20 61 66 74 65 72 20 l $t1. after
6420: 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 61 cancel $t2. a
6430: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a fter cancel $t3.
6440: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
6450: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
6460: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 ppend l [list p1
6470: 20 5b 67 65 74 73 20 24 70 31 5d 20 24 78 5d 0a [gets $p1] $x].
6480: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
6490: 69 73 74 20 70 32 20 5b 67 65 74 73 20 24 70 32 ist p2 [gets $p2
64a0: 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e ] $x]. lappen
64b0: 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 d l [list p3 [ge
64c0: 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 ts $p3] $x].
64d0: 70 75 74 73 20 24 70 31 20 62 79 65 0a 20 20 20 puts $p1 bye.
64e0: 20 70 75 74 73 20 24 70 32 20 62 79 65 0a 20 20 puts $p2 bye.
64f0: 20 20 70 75 74 73 20 24 70 33 20 62 79 65 0a 20 puts $p3 bye.
6500: 20 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 close $p1.
6510: 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 63 close $p2. c
6520: 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 73 65 74 lose $p3. set
6530: 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 6f l.} {{p1 bye do
6540: 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e 65 ne} {p2 bye done
6550: 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d 7d } {p3 bye done}}
6560: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e 32 ..test tlsIO-4.2
6570: 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f {byte order pro
6580: 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 blems, socket nu
6590: 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 mbers, htons} {s
65a0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
65b0: 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b 63 x ok. if {[c
65c0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
65d0: 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 t -server dodo 0
65e0: 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 x3000} msg]} {..
65f0: 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d set x $msg. }
6600: 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 else {..close $
6610: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 msg. }. se
6620: 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 t x.} ok..test t
6630: 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 74 65 20 6f lsIO-5.1 {byte o
6640: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
6650: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
6660: 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 tons} \..{socket
6670: 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f unixOnly notRoo
6680: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b t} {. set x {
6690: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
66a0: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
66b0: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
66c0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
66d0: 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 7d 20 erver dodo 0x1}
66e0: 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 msg]} {.
66f0: 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f set x {htons pro
6700: 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 blem, should be
6710: 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 disallowed, are
6720: 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 you running as S
6730: 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a U?}..close $msg.
6740: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a }. set x.
6750: 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e } {couldn't open
6760: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
6770: 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 er}.test tlsIO-5
6780: 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 .2 {byte order p
6790: 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 roblems, socket
67a0: 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 numbers, htons}
67b0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
67c0: 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f et x {couldn't o
67d0: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 pen socket: port
67e0: 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 number too high
67f0: 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 }. if {![catc
6800: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
6810: 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 30 server dodo 0x10
6820: 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 000} msg]} {..se
6830: 74 20 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c 75 t x {port resolu
6840: 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 68 tion problem, sh
6850: 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 ould be disallow
6860: 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a ed}..close $msg.
6870: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a }. set x.
6880: 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e } {couldn't open
6890: 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 socket: port nu
68a0: 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 74 mber too high}.t
68b0: 65 73 74 20 74 6c 73 49 4f 2d 35 2e 33 20 7b 62 est tlsIO-5.3 {b
68c0: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
68d0: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
68e0: 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 rs, htons} \..{s
68f0: 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e ocket unixOnly n
6900: 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 otRoot} {. se
6910: 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 t x {couldn't op
6920: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
6930: 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b wner}. if {![
6940: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
6950: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
6960: 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 21} msg]} {..set
6970: 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 x {htons proble
6980: 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 m, should be dis
6990: 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 allowed, are you
69a0: 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d running as SU?}
69b0: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 ..close $msg.
69c0: 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b }. set x.} {
69d0: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
69e0: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
69f0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 36 2e 31 ..test tlsIO-6.1
6a00: 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 {accept callbac
6a10: 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 k error} {socket
6a20: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 23 20 stdio} {. #
6a30: 54 68 65 72 65 20 69 73 20 61 20 64 65 62 75 67 There is a debug
6a40: 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 57 69 assertion on Wi
6a50: 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 20 63 ndows/SSL that c
6a60: 61 75 73 65 73 20 61 20 63 72 61 73 68 20 77 68 auses a crash wh
6a70: 65 6e 20 74 68 65 0a 20 20 20 20 23 20 63 65 72 en the. # cer
6a80: 74 69 66 69 63 61 74 65 20 69 73 6e 27 74 20 73 tificate isn't s
6a90: 70 65 63 69 66 69 65 64 2e 0a 20 20 20 20 72 65 pecified.. re
6aa0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
6ab0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
6ac0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
6ad0: 74 73 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 ts $f {..set aut
6ae0: 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 o_path [linsert
6af0: 24 61 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 $auto_path 0 [li
6b00: 6e 64 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 ndex [split $env
6b10: 28 50 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d (PATH) ";:"] 0]]
6b20: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
6b30: 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 quire tls..gets
6b40: 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 stdin. }.
6b50: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 74 6c puts $f [list tl
6b60: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c s::socket -cafil
6b70: 65 20 24 63 61 43 65 72 74 20 31 32 37 2e 30 2e e $caCert 127.0.
6b80: 30 2e 31 20 38 38 34 38 5d 0a 20 20 20 20 63 6c 0.1 8848]. cl
6b90: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
6ba0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
6bb0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
6bc0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
6bd0: 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 proc bgerror
6be0: 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 args {..global
6bf0: 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 x..set x $args.
6c00: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 }. proc ac
6c10: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 cept {s a p} {ex
6c20: 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 pr 10 / 0}. s
6c30: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
6c40: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
6c50: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
6c60: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
6c70: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
6c80: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
6c90: 79 20 38 38 34 38 5d 0a 20 20 20 20 70 75 74 73 y 8848]. puts
6ca0: 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c $f hello. cl
6cb0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 74 ose $f. set t
6cc0: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
6cd0: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
6ce0: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut"]. vwait x
6cf0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
6d00: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
6d10: 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 se $s. rename
6d20: 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 bgerror {}.
6d30: 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 set x.} {{divide
6d40: 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 by zero}}..test
6d50: 20 74 6c 73 49 4f 2d 37 2e 31 20 7b 74 65 73 74 tlsIO-7.1 {test
6d60: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
6d70: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
6d80: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
6d90: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
6da0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
6db0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
6dc0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 puts $f {..set
6dd0: 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 auto_path [lins
6de0: 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 ert $auto_path 0
6df0: 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 [lindex [split
6e00: 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d $env(PATH) ";:"]
6e10: 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 0]]..package re
6e20: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
6e30: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
6e40: 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 t tls::socket -s
6e50: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
6e60: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
6e70: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
6e80: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
6e90: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
6ea0: 32 30 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 20]. puts $f
6eb0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 {..proc accept a
6ec0: 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 rgs {.. globa
6ed0: 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 l x.. set x d
6ee0: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
6ef0: 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 dy..set timer [a
6f00: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
6f10: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 x timed_out"]..v
6f20: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
6f30: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
6f40: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
6f50: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
6f60: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
6f70: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
6f80: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
6f90: 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c $f. set s [tl
6fa0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
6fb0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
6fc0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
6fd0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6fe0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
6ff0: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 30 127.0.0.1 8820
7000: 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f ]. set p [fco
7010: 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 nfigure $s -peer
7020: 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 name]. close
7030: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a $s. close $f.
7040: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
7050: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 lappend l [stri
7060: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 ng compare [lind
7070: 65 78 20 24 70 20 30 5d 20 31 32 37 2e 30 2e 30 ex $p 0] 127.0.0
7080: 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 .1]. lappend
7090: 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 l [string compar
70a0: 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 e [lindex $p 2]
70b0: 38 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 8820]. lappen
70c0: 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d d l [llength $p]
70d0: 0a 7d 20 7b 30 20 30 20 33 7d 0a 0a 74 65 73 74 .} {0 0 3}..test
70e0: 20 74 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 73 74 tlsIO-7.2 {test
70f0: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
7100: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
7110: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
7120: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
7130: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
7140: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
7150: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 puts $f {..set
7160: 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e 73 auto_path [lins
7170: 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 30 ert $auto_path 0
7180: 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 20 [lindex [split
7190: 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 5d $env(PATH) ";:"]
71a0: 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 65 0]]..package re
71b0: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
71c0: 20 20 20 20 70 75 74 73 20 24 66 20 22 74 6c 73 puts $f "tls
71d0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
71e0: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
71f0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
7200: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7210: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
7220: 79 20 38 38 32 31 22 0a 20 20 20 20 70 75 74 73 y 8821". puts
7230: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
7240: 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 pt args {.. g
7250: 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 lobal x.. set
7260: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
7270: 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 ready..set time
7280: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
7290: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
72a0: 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 ]..vwait x..afte
72b0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
72c0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
72d0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
72e0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
72f0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
7300: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
7310: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 ets $f. set s
7320: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
7330: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
7340: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7350: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7360: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
7370: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
7380: 38 38 32 31 5d 0a 20 20 20 20 73 65 74 20 70 20 8821]. set p
7390: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
73a0: 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 6c sockname]. cl
73b0: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
73c0: 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 $f. set l ""
73d0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
73e0: 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 llength $p].
73f0: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 lappend l [linde
7400: 78 20 24 70 20 30 5d 0a 20 20 20 20 6c 61 70 70 x $p 0]. lapp
7410: 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 65 71 end l [string eq
7420: 75 61 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 ual [lindex $p 2
7430: 5d 20 38 38 32 31 5d 0a 7d 20 7b 33 20 31 32 37 ] 8821].} {3 127
7440: 2e 30 2e 30 2e 31 20 30 7d 0a 0a 74 65 73 74 20 .0.0.1 0}..test
7450: 74 6c 73 49 4f 2d 37 2e 33 20 7b 74 65 73 74 69 tlsIO-7.3 {testi
7460: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
7470: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 ic options} {soc
7480: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ket} {. set s
7490: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
74a0: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
74b0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
74c0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
74d0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 $serverKey \.
74e0: 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 .-server accept
74f0: 20 38 38 32 32 5d 0a 20 20 20 20 73 65 74 20 6c 8822]. set l
7500: 20 5b 6c 6c 65 6e 67 74 68 20 5b 66 63 6f 6e 66 [llength [fconf
7510: 69 67 75 72 65 20 24 73 5d 5d 0a 20 20 20 20 63 igure $s]]. c
7520: 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 lose $s. upda
7530: 74 65 0a 20 20 20 20 23 20 41 20 62 75 67 20 66 te. # A bug f
7540: 69 78 65 64 20 69 6e 20 66 63 6f 6e 66 69 67 75 ixed in fconfigu
7550: 72 65 20 66 6f 72 20 38 2e 33 2e 34 2b 20 6d 61 re for 8.3.4+ ma
7560: 6b 65 20 74 68 69 73 20 72 65 74 75 72 6e 20 31 ke this return 1
7570: 34 20 6e 6f 72 6d 61 6c 6c 79 2c 0a 20 20 20 20 4 normally,.
7580: 23 20 62 75 74 20 31 32 20 69 6e 20 6f 6c 64 65 # but 12 in olde
7590: 72 20 76 65 72 73 69 6f 6e 73 2e 0a 20 20 20 20 r versions..
75a0: 65 78 70 72 20 7b 24 6c 20 3e 3d 20 31 32 20 26 expr {$l >= 12 &
75b0: 26 20 28 28 24 6c 20 25 20 32 29 20 3d 3d 20 30 & (($l % 2) == 0
75c0: 29 7d 0a 7d 20 31 0a 0a 23 20 62 75 67 20 72 65 )}.} 1..# bug re
75d0: 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 port #5812 fconf
75e0: 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 igure doesn't re
75f0: 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 turn value for '
7600: 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 -sockname'..test
7610: 20 74 6c 73 49 4f 2d 37 2e 34 20 7b 74 65 73 74 tlsIO-7.4 {test
7620: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
7630: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
7640: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
7650: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
7660: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
7670: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
7680: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7690: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 $serverKey \.
76a0: 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 .-server accep
76b0: 74 20 38 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 t 8823]. proc
76c0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
76d0: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 {..global x..set
76e0: 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 x [fconfigure $
76f0: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c s -sockname]..cl
7700: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
7710: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
7720: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
7730: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
7740: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7750: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
7760: 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 y \. .[info h
7770: 6f 73 74 6e 61 6d 65 5d 20 38 38 32 33 5d 0a 20 ostname] 8823].
7780: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
7790: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
77a0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
77b0: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
77c0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
77d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
77e0: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
77f0: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
7800: 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 pend l [lindex $
7810: 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 x 2] [llength $x
7820: 5d 0a 7d 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 ].} {8823 3}..#
7830: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
7840: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
7850: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
7860: 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 for '-sockname'
7870: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 ..test tlsIO-7.5
7880: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
7890: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
78a0: 73 7d 20 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f s} {socket unixO
78b0: 72 50 63 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 rPc} {. set s
78c0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
78d0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
78e0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
78f0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7900: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
7910: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
7920: 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 cept 8829]. p
7930: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
7940: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 p} {..global x..
7950: 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 set x [fconfigur
7960: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
7970: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
7980: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
7990: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
79a0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
79b0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
79c0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
79d0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
79e0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 0a 127.0.0.1 8829].
79f0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
7a00: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
7a10: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
7a20: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 vwait x. af
7a30: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
7a40: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
7a50: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
7a60: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
7a70: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
7a80: 24 78 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 $x 0] [lindex $x
7a90: 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 2] [llength $x]
7aa0: 0a 7d 20 7b 31 32 37 2e 30 2e 30 2e 31 20 38 38 .} {127.0.0.1 88
7ab0: 32 39 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 29 3}..test tlsI
7ac0: 4f 2d 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d O-8.1 {testing -
7ad0: 61 73 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f async flag on so
7ae0: 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 ckets} {socket}
7af0: 7b 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 {. # NOTE: Th
7b00: 69 73 20 74 65 73 74 20 6d 61 79 20 66 61 69 6c is test may fail
7b10: 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 on some Solaris
7b20: 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 0a 20 20 2.4 systems..
7b30: 20 20 23 20 53 65 65 20 6e 6f 74 65 73 20 69 6e # See notes in
7b40: 20 54 63 6c 27 73 20 73 6f 63 6b 65 74 2e 74 65 Tcl's socket.te
7b50: 73 74 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 st.. set s [t
7b60: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
7b70: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
7b80: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
7b90: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7ba0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
7bb0: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
7bc0: 74 20 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 t 8830]. proc
7bd0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
7be0: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 23 20 77 {..global x..# w
7bf0: 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d hen doing an in-
7c00: 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 process client/s
7c10: 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 erver test, both
7c20: 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 20 74 sides need..# t
7c30: 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e o be non-blockin
7c40: 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 g for the TLS ha
7c50: 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d ndshake. Also m
7c60: 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f 20 72 ake sure..# to r
7c70: 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 eturn the channe
7c80: 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 l to line buffer
7c90: 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 ing mode...fconf
7ca0: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
7cb0: 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 ng 0 -buffering
7cc0: 6c 69 6e 65 0a 09 70 75 74 73 20 24 73 20 62 79 line..puts $s by
7cd0: 65 0a 09 23 20 4f 6e 6c 79 20 4f 70 65 6e 53 53 e..# Only OpenSS
7ce0: 4c 20 30 2e 39 2e 35 61 20 6f 6e 20 57 69 6e 64 L 0.9.5a on Wind
7cf0: 6f 77 73 20 73 65 65 6d 73 20 74 6f 20 6e 65 65 ows seems to nee
7d00: 64 20 74 68 65 20 61 66 74 65 72 20 28 64 65 6c d the after (del
7d10: 61 79 65 64 29 0a 09 23 20 63 6c 6f 73 65 2c 20 ayed)..# close,
7d20: 62 75 74 20 69 74 20 77 6f 72 6b 73 20 6a 75 73 but it works jus
7d30: 74 20 74 68 65 20 73 61 6d 65 20 66 6f 72 20 61 t the same for a
7d40: 6c 6c 20 6f 74 68 65 72 73 2e 20 2d 68 6f 62 62 ll others. -hobb
7d50: 73 0a 09 61 66 74 65 72 20 35 30 30 20 63 6c 6f s..after 500 clo
7d60: 73 65 20 24 73 0a 09 73 65 74 20 78 20 64 6f 6e se $s..set x don
7d70: 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 e. }. set
7d80: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
7d90: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
7da0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
7db0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7dc0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
7dd0: 20 5c 0a 09 20 20 20 20 2d 61 73 79 6e 63 20 5b \.. -async [
7de0: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 info hostname] 8
7df0: 38 33 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 830]. # when
7e00: 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 doing an in-proc
7e10: 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 ess client/serve
7e20: 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 r test, both sid
7e30: 65 73 20 6e 65 65 64 0a 20 20 20 20 23 20 74 6f es need. # to
7e40: 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 be non-blocking
7e50: 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e for the TLS han
7e60: 64 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b dshake Also mak
7e70: 65 20 73 75 72 65 20 74 6f 0a 20 20 20 20 23 20 e sure to. #
7e80: 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e return the chann
7e90: 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 el to line buffe
7ea0: 72 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 ring mode (TLS s
7eb0: 65 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 ets it to 'none'
7ec0: 29 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ).. fconfigur
7ed0: 65 20 24 73 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 e $s1 -blocking
7ee0: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
7ef0: 65 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 e. vwait x.
7f00: 20 20 23 20 54 4c 53 20 68 61 6e 64 73 68 61 6b # TLS handshak
7f10: 69 6e 67 20 6e 65 65 64 73 20 6f 6e 65 20 62 79 ing needs one by
7f20: 74 65 20 66 72 6f 6d 20 74 68 65 20 63 6c 69 65 te from the clie
7f30: 6e 74 2e 2e 2e 0a 20 20 20 20 70 75 74 73 20 24 nt.... puts $
7f40: 73 31 20 61 0a 20 20 20 20 23 20 6e 65 65 64 20 s1 a. # need
7f50: 75 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 update to comple
7f60: 74 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 te TLS handshake
7f70: 20 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 in-process.
7f80: 75 70 64 61 74 65 0a 20 20 20 20 73 65 74 20 7a update. set z
7f90: 20 5b 67 65 74 73 20 24 73 31 5d 0a 20 20 20 20 [gets $s1].
7fa0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
7fb0: 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 7a se $s1. set z
7fc0: 0a 7d 20 62 79 65 0a 0a 74 65 73 74 20 74 6c 73 .} bye..test tls
7fd0: 49 4f 2d 39 2e 31 20 7b 74 65 73 74 69 6e 67 20 IO-9.1 {testing
7fe0: 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d spurious events}
7ff0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
8000: 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 set len 0. se
8010: 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 t spurious 0.
8020: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
8030: 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 proc readlittle
8040: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 {s} {..global sp
8050: 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a urious done len.
8060: 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 .set l [read $s
8070: 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 1]..if {[string
8080: 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d length $l] == 0}
8090: 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f {.. if {![eo
80a0: 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 f $s]} {...incr
80b0: 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 spurious.. }
80c0: 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 else {...close $
80d0: 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 s...set done 1..
80e0: 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a }..} else {.
80f0: 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 . incr len [s
8100: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
8110: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ..}. }. pr
8120: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
8130: 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 } {..fconfigure
8140: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 $s -blocking 0..
8150: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
8160: 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 dable [list do_h
8170: 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 andshake $s read
8180: 61 62 6c 65 20 72 65 61 64 6c 69 74 74 6c 65 20 able readlittle
8190: 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6e \...-buffering n
81a0: 6f 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 one]. }. s
81b0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
81c0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
81d0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
81e0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
81f0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8200: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
8210: 72 20 61 63 63 65 70 74 20 38 38 33 31 5d 0a 20 r accept 8831].
8220: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
8230: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8240: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
8250: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8260: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
8270: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 entKey \.. [i
8280: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 nfo hostname] 88
8290: 33 31 5d 0a 20 20 20 20 23 20 54 68 69 73 20 64 31]. # This d
82a0: 69 66 66 65 72 73 20 66 72 6f 6d 20 73 6f 63 6b iffers from sock
82b0: 65 74 2d 39 2e 31 20 69 6e 20 74 68 61 74 20 62 et-9.1 in that b
82c0: 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 20 74 oth sides need t
82d0: 6f 20 62 65 0a 20 20 20 20 23 20 6e 6f 6e 2d 62 o be. # non-b
82e0: 6c 6f 63 6b 69 6e 67 20 62 65 63 61 75 73 65 20 locking because
82f0: 6f 66 20 54 4c 53 27 20 72 65 71 75 69 72 65 64 of TLS' required
8300: 20 68 61 6e 64 73 68 61 6b 65 0a 20 20 20 20 66 handshake. f
8310: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
8320: 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 74 ocking 0. put
8330: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 s -nonewline $c
8340: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 0123456789012345
8350: 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 6789012345678901
8360: 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 2345678901234567
8370: 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 89. close $c.
8380: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
8390: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
83a0: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
83b0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
83c0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
83d0: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
83e0: 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 73 e $s. list $s
83f0: 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b purious $len.} {
8400: 30 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 0 50}..test tlsI
8410: 4f 2d 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 61 O-9.2 {testing a
8420: 73 79 6e 63 20 77 72 69 74 65 2c 20 66 69 6c 65 sync write, file
8430: 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f 6e events, flush on
8440: 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 74 7d close} {socket}
8450: 20 7b 0a 20 20 20 20 73 65 74 20 66 69 72 73 74 {. set first
8460: 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 block [string re
8470: 70 65 61 74 20 61 20 33 31 5d 0a 20 20 20 20 73 peat a 31]. s
8480: 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b et secondblock [
8490: 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 62 20 string repeat b
84a0: 36 35 35 33 35 5d 0a 20 20 20 20 70 72 6f 63 20 65535]. proc
84b0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
84c0: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
84d0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c -blocking 0..fil
84e0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
84f0: 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 le [list do_hand
8500: 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 62 6c shake $s readabl
8510: 65 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 09 2d e readable \...-
8520: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d translation lf -
8530: 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 buffersize 16384
8540: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
8550: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 ]. }. proc
8560: 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a readable {s} {.
8570: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d .set l [gets $s]
8580: 0a 09 64 70 75 74 73 20 22 67 6f 74 20 5c 22 5b ..dputs "got \"[
8590: 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 string replace $
85a0: 6c 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c l 10 end-3 ...]\
85b0: 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c " \...([string l
85c0: 65 6e 67 74 68 20 24 6c 5d 29 20 66 72 6f 6d 20 ength $l]) from
85d0: 24 73 22 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 $s"..fileevent $
85e0: 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 61 s readable {}..a
85f0: 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e fter 1000 respon
8600: 64 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 d $s. }. p
8610: 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 roc respond {s}
8620: 7b 0a 09 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 {..global firstb
8630: 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 65 6e lock..dputs "sen
8640: 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 6c d \"[string repl
8650: 61 63 65 20 24 66 69 72 73 74 62 6c 6f 63 6b 20 ace $firstblock
8660: 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 10 end-3 ...]\"
8670: 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e \...([string len
8680: 67 74 68 20 24 66 69 72 73 74 62 6c 6f 63 6b 5d gth $firstblock]
8690: 29 20 64 6f 77 6e 20 24 73 22 0a 09 70 75 74 73 ) down $s"..puts
86a0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
86b0: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 74 65 firstblock..afte
86c0: 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 r 1000 writedata
86d0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s. }. pr
86e0: 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d oc writedata {s}
86f0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 6f 6e {..global secon
8700: 64 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 22 73 dblock..dputs "s
8710: 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 end \"[string re
8720: 70 6c 61 63 65 20 24 73 65 63 6f 6e 64 62 6c 6f place $secondblo
8730: 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d ck 10 end-3 ...]
8740: 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 \" \...([string
8750: 6c 65 6e 67 74 68 20 24 73 65 63 6f 6e 64 62 6c length $secondbl
8760: 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 0a 09 ock]) down $s"..
8770: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
8780: 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a $s $secondblock.
8790: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
87a0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
87b0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
87c0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
87d0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
87e0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
87f0: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
8800: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
8810: 33 32 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 32]. set c [t
8820: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
8830: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
8840: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8850: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8860: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8870: 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d [info hostnam
8880: 65 5d 20 38 38 33 32 5d 0a 20 20 20 20 66 63 6f e] 8832]. fco
8890: 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 nfigure $c -bloc
88a0: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 king 0 -trans lf
88b0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
88c0: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 . set count 0
88d0: 0a 20 20 20 20 70 75 74 73 20 24 63 20 68 65 6c . puts $c hel
88e0: 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 lo. proc read
88f0: 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c it {s} {..global
8900: 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 count done..set
8910: 20 64 61 74 61 20 5b 72 65 61 64 20 24 73 5d 0a data [read $s].
8920: 09 64 70 75 74 73 20 22 72 65 61 64 20 5c 22 5b .dputs "read \"[
8930: 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 string replace $
8940: 64 61 74 61 20 31 30 20 65 6e 64 2d 33 20 2e 2e data 10 end-3 ..
8950: 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e .]\" \...([strin
8960: 67 20 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 29 g length $data])
8970: 20 66 72 6f 6d 20 24 73 22 0a 09 69 6e 63 72 20 from $s"..incr
8980: 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 count [string le
8990: 6e 67 74 68 20 24 64 61 74 61 5d 0a 09 69 66 20 ngth $data]..if
89a0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
89b0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 close $s..
89c0: 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 set done 1..}.
89d0: 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e }. fileeven
89e0: 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 72 t $c readable "r
89f0: 65 61 64 69 74 20 24 63 22 0a 20 20 20 20 73 65 eadit $c". se
8a00: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 t done 0. set
8a10: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
8a20: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
8a30: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
8a40: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
8a50: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
8a60: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
8a70: 20 20 6c 69 73 74 20 24 63 6f 75 6e 74 20 24 64 list $count $d
8a80: 6f 6e 65 0a 7d 20 7b 36 35 35 36 36 20 31 7d 0a one.} {65566 1}.
8a90: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 33 20 .test tlsIO-9.3
8aa0: 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 {testing EOF sti
8ab0: 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c ckyness} {unexpl
8ac0: 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 ainedFailure soc
8ad0: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 ket} {. # HOB
8ae0: 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 BS: never worked
8af0: 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 70 correctly. p
8b00: 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 roc count_to_eof
8b10: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
8b20: 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a ount done timer.
8b30: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d .set l [gets $s]
8b40: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
8b50: 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e {.. incr coun
8b60: 74 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e t.. if {$coun
8b70: 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 t > 9} {...close
8b80: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 $s...set done t
8b90: 72 75 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 rue...set count
8ba0: 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a {eof is sticky}.
8bb0: 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
8bc0: 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a timer.. }..}.
8bd0: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 }. proc t
8be0: 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 imerproc {} {..g
8bf0: 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 lobal done count
8c00: 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 75 c..set done tru
8c10: 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 e..set count {ti
8c20: 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f mer went off, eo
8c30: 66 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d f is not sticky}
8c40: 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d ..close $c. }
8c50: 09 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 .. set count
8c60: 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 66 0. set done f
8c70: 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 72 alse. proc wr
8c80: 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b ite_then_close {
8c90: 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 79 s} {..puts $s by
8ca0: 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 e..close $s.
8cb0: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 }. proc accep
8cc0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f t {s a p} {..fco
8cd0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
8ce0: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e king 0 -bufferin
8cf0: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
8d00: 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e ion lf..fileeven
8d10: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 5b 6c t $s writable [l
8d20: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
8d30: 20 24 73 20 77 72 69 74 61 62 6c 65 20 77 72 69 $s writable wri
8d40: 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 5c 0a te_then_close \.
8d50: 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e ..-buffering lin
8d60: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c e -translation l
8d70: 66 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 f]. }. set
8d80: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
8d90: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
8da0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
8db0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8dc0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
8dd0: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
8de0: 61 63 63 65 70 74 20 38 38 33 33 5d 0a 20 20 20 accept 8833].
8df0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
8e00: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
8e10: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
8e20: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8e30: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
8e40: 74 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 tKey \.. [inf
8e50: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 33 o hostname] 8833
8e60: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
8e70: 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $c -blocking 0
8e80: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
8e90: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a -translation lf.
8ea0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
8eb0: 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 readable "count
8ec0: 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 _to_eof $c".
8ed0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
8ee0: 20 32 30 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 2000 timerproc]
8ef0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
8f00: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
8f10: 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f set count.} {eo
8f20: 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 f is sticky}..re
8f30: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
8f40: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 30 2e 31 .test tlsIO-10.1
8f50: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
8f60: 20 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b accept callback
8f70: 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d error handling}
8f80: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
8f90: 73 65 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 set goterror 0.
8fa0: 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 proc bgerror
8fb0: 61 72 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 args {global got
8fc0: 65 72 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 error; set goter
8fd0: 72 6f 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 ror 1}. set s
8fe0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
8ff0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 73 afile $caCert -s
9000: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 39 erver accept 889
9010: 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 8]. proc acce
9020: 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 pt {s a p} {clos
9030: 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a 20 20 20 e $s; error}.
9040: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
9050: 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ket -cafile $caC
9060: 65 72 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 ert 127.0.0.1 88
9070: 39 38 5d 0a 20 20 20 20 76 77 61 69 74 20 67 6f 98]. vwait go
9080: 74 65 72 72 6f 72 0a 20 20 20 20 63 6c 6f 73 65 terror. close
9090: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 $s. close $c
90a0: 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f . set goterro
90b0: 72 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 r.} 1..test tlsI
90c0: 4f 2d 31 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e O-11.1 {tcp conn
90d0: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 ection} {socket
90e0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
90f0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
9100: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
9110: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
9120: 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 31 5f 74 .set socket9_1_t
9130: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
9140: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
9150: 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 accept \...-cert
9160: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
9170: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9180: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
9190: 72 4b 65 79 20 38 38 33 34 5d 0a 09 70 72 6f 63 rKey 8834]..proc
91a0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
91b0: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 {.. tls::hand
91c0: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 shake $s.. pu
91d0: 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 ts $s done..
91e0: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
91f0: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
9200: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9210: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
9220: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
9230: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9240: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9250: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9260: 20 38 38 33 34 5d 0a 20 20 20 20 73 65 74 20 72 8834]. set r
9270: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
9280: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 lose $s. send
9290: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
92a0: 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 socket9_1_test_s
92b0: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 72 erver}. set r
92c0: 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 74 20 74 6c .} done..test tl
92d0: 73 49 4f 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 sIO-11.2 {client
92e0: 20 73 70 65 63 69 66 69 65 73 20 69 74 73 20 70 specifies its p
92f0: 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ort} {socket doT
9300: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9310: 72 76 65 72 7d 20 7b 0a 20 20 20 20 69 66 20 7b rver} {. if {
9320: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 [info exists por
9330: 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 6f 72 74 t]} {..incr port
9340: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
9350: 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 7b 24 et port [expr {$
9360: 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 2b 20 tlsServerPort +
9370: 5b 70 69 64 5d 25 31 30 32 34 7d 5d 0a 20 20 20 [pid]%1024}].
9380: 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 }. sendCertV
9390: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
93a0: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
93b0: 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 ket9_2_test_serv
93c0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
93d0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
93e0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
93f0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9400: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9410: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
9420: 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 5]..proc accept
9430: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
9440: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
9450: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 24 70 .. puts $s $p
9460: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
9470: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
9480: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
9490: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
94a0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
94b0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
94c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
94d0: 5c 0a 09 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 \.. -myport $
94e0: 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 port $remoteServ
94f0: 65 72 49 50 20 38 38 33 35 5d 0a 20 20 20 20 73 erIP 8835]. s
9500: 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 et r [gets $s].
9510: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
9520: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
9530: 73 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 se $socket9_2_te
9540: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 69 st_server}. i
9550: 66 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 f {$r == $port}
9560: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 6f 6b {..set result ok
9570: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
9580: 65 74 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e et result broken
9590: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 72 . }. set r
95a0: 65 73 75 6c 74 0a 7d 20 6f 6b 0a 0a 74 65 73 74 esult.} ok..test
95b0: 20 74 6c 73 49 4f 2d 31 31 2e 33 20 7b 74 72 79 tlsIO-11.3 {try
95c0: 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 ing to connect,
95d0: 6e 6f 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b no server} {sock
95e0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
95f0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9600: 20 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a set status ok.
9610: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
9620: 7b 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 {set s [tls::soc
9630: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
9640: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
9650: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
9660: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
9670: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
9680: 6f 74 65 53 65 72 76 65 72 49 70 20 38 38 33 36 oteServerIp 8836
9690: 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 ]}]} {..if {![ca
96a0: 74 63 68 20 7b 67 65 74 73 20 24 73 7d 5d 7d 20 tch {gets $s}]}
96b0: 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 75 {.. set statu
96c0: 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f s broken..}..clo
96d0: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
96e0: 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a set status.} ok.
96f0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 34 .test tlsIO-11.4
9700: 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 6f {remote echo, o
9710: 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 ne line} {socket
9720: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
9730: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
9740: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
9750: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9760: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 ..set socket10_6
9770: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
9780: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 s::socket \...-c
9790: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
97a0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
97b0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
97c0: 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 rverKey \...-ser
97d0: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d ver accept 8836]
97e0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
97f0: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
9800: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
9810: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
9820: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
9830: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
9840: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
9850: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
9860: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d nslation crlf..}
9870: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
9880: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
9890: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b ts $s].. if {
98a0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
98b0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
98c0: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 se {...puts $s $
98d0: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 l.. }..}.
98e0: 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 }. set f [tls
98f0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9900: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
9910: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
9920: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9930: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9940: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9950: 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 8836]. fconf
9960: 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c igure $f -transl
9970: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 ation crlf -buff
9980: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 ering line. p
9990: 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 uts $f hello.
99a0: 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 66 5d set r [gets $f]
99b0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
99c0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
99d0: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 lose $socket10_6
99e0: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
99f0: 20 20 73 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a set r.} hello.
9a00: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 .test tlsIO-11.5
9a10: 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 {remote echo, 5
9a20: 30 20 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 0 lines} {socket
9a30: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
9a40: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
9a50: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
9a60: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9a70: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 ..set socket10_7
9a80: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
9a90: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
9aa0: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 r accept \...-ce
9ab0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
9ac0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9ad0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
9ae0: 76 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 verKey 8836]..pr
9af0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
9b00: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
9b10: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
9b20: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
9b30: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
9b40: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
9b50: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
9b60: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
9b70: 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 tion crlf..}..pr
9b80: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
9b90: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
9ba0: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
9bb0: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
9bc0: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
9bd0: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
9be0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
9bf0: 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f set f [tls::so
9c00: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
9c10: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
9c20: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9c30: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
9c40: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
9c50: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
9c60: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
9c70: 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $f -translatio
9c80: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
9c90: 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b g line. for {
9ca0: 73 65 74 20 63 6e 74 20 30 7d 20 7b 24 63 6e 74 set cnt 0} {$cnt
9cb0: 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 63 6e 74 < 50} {incr cnt
9cc0: 7d 20 7b 0a 09 70 75 74 73 20 24 66 20 22 68 65 } {..puts $f "he
9cd0: 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 69 66 20 7b llo, $cnt"..if {
9ce0: 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 [string compare
9cf0: 5b 67 65 74 73 20 24 66 5d 20 22 68 65 6c 6c 6f [gets $f] "hello
9d00: 2c 20 24 63 6e 74 22 5d 20 21 3d 20 30 7d 20 7b , $cnt"] != 0} {
9d10: 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 .. break..}.
9d20: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
9d30: 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e f. sendComman
9d40: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
9d50: 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 10_7_test_server
9d60: 7d 0a 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 }. set cnt.}
9d70: 35 30 0a 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 50..# Macintosh
9d80: 73 6f 63 6b 65 74 73 20 63 61 6e 20 68 61 76 65 sockets can have
9d90: 20 6d 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 more than one s
9da0: 65 72 76 65 72 20 70 65 72 20 70 6f 72 74 0a 69 erver per port.i
9db0: 66 20 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d f {$tcl_platform
9dc0: 28 70 6c 61 74 66 6f 72 6d 29 20 3d 3d 20 22 6d (platform) == "m
9dd0: 61 63 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 acintosh"} {.
9de0: 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 set conflictRes
9df0: 75 6c 74 20 7b 30 20 38 38 33 36 7d 0a 7d 20 65 ult {0 8836}.} e
9e00: 6c 73 65 20 7b 0a 20 20 20 20 73 65 74 20 63 6f lse {. set co
9e10: 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 20 nflictResult {1
9e20: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
9e30: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
9e40: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a lready in use}}.
9e50: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 }..test tlsIO-11
9e60: 2e 36 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c .6 {socket confl
9e70: 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ict} {socket doT
9e80: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9e90: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
9ea0: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
9eb0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9ec0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
9ed0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9ee0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
9ef0: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
9f00: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 20 20 20 accept 8836].
9f10: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 if {[catch {set
9f20: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
9f30: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
9f40: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
9f50: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9f60: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
9f70: 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 y \.. -server
9f80: 20 61 63 63 65 70 74 20 38 38 33 36 5d 7d 20 6d accept 8836]} m
9f90: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 sg]} {..set resu
9fa0: 6c 74 20 5b 6c 69 73 74 20 31 20 24 6d 73 67 5d lt [list 1 $msg]
9fb0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
9fc0: 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 et result [list
9fd0: 30 20 5b 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 66 0 [lindex [fconf
9fe0: 69 67 75 72 65 20 24 73 32 20 2d 73 6f 63 6b 6e igure $s2 -sockn
9ff0: 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 ame] 2]]..close
a000: 24 73 32 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $s2. }. cl
a010: 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 ose $s1. set
a020: 72 65 73 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 result.} $confli
a030: 63 74 52 65 73 75 6c 74 0a 0a 74 65 73 74 20 74 ctResult..test t
a040: 6c 73 49 4f 2d 31 31 2e 37 20 7b 73 65 72 76 65 lsIO-11.7 {serve
a050: 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 r with several c
a060: 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 lients} {socket
a070: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
a080: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
a090: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
a0a0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
a0b0: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 39 5f .set socket10_9_
a0c0: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
a0d0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 ::socket \...-ce
a0e0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
a0f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
a100: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
a110: 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 verKey \...-serv
a120: 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a er accept 8836].
a130: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
a140: 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e a p} {.. fcon
a150: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
a160: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 ring line.. f
a170: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
a180: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
a190: 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 $s]..}..proc ech
a1a0: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
a1b0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
a1c0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
a1d0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
a1e0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
a1f0: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
a200: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
a210: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
a220: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
a230: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
a240: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a250: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
a260: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
a270: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
a280: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 fconfigure $s1
a290: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
a2a0: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
a2b0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
a2c0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
a2d0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
a2e0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
a2f0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
a300: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
a310: 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 8836]. fconf
a320: 69 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 igure $s2 -buffe
a330: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
a340: 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s3 [tls::socke
a350: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
a360: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
a370: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a380: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
a390: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
a3a0: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
a3b0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
a3c0: 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s3 -buffering li
a3d0: 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 ne. for {set
a3e0: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
a3f0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 {incr i} {..puts
a400: 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 $s1 hello,s1..g
a410: 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 ets $s1..puts $s
a420: 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 2 hello,s2..gets
a430: 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 $s2..puts $s3 h
a440: 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 ello,s3..gets $s
a450: 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 3. }. clos
a460: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
a470: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
a480: 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 3. sendComman
a490: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
a4a0: 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 10_9_test_server
a4b0: 7d 0a 20 20 20 20 73 65 74 20 69 0a 7d 20 31 30 }. set i.} 10
a4c0: 30 20 20 20 20 0a 0a 74 65 73 74 20 74 6c 73 49 0 ..test tlsI
a4d0: 4f 2d 31 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 O-11.8 {client w
a4e0: 69 74 68 20 73 65 76 65 72 61 6c 20 73 65 72 76 ith several serv
a4f0: 65 72 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ers} {socket doT
a500: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
a510: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
a520: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
a530: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 74 6c endCommand {..tl
a540: 73 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 6c s::init -certfil
a550: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
a560: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
a570: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
a580: 79 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a y..set s1 [tls::
a590: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 socket -server "
a5a0: 61 63 63 65 70 74 20 34 30 30 33 22 20 34 30 30 accept 4003" 400
a5b0: 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3]..set s2 [tls:
a5c0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
a5d0: 22 61 63 63 65 70 74 20 34 30 30 34 22 20 34 30 "accept 4004" 40
a5e0: 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 6c 73 04]..set s3 [tls
a5f0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
a600: 20 22 61 63 63 65 70 74 20 34 30 30 35 22 20 34 "accept 4005" 4
a610: 30 30 35 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 005]..proc hands
a620: 68 61 6b 65 20 7b 73 20 6d 70 7d 20 7b 0a 09 20 hake {s mp} {..
a630: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
a640: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 {...close $s..
a650: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 } elseif {[ca
a660: 74 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 tch {tls::handsh
a670: 61 6b 65 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d ake $s} result]}
a680: 20 7b 0a 09 09 23 20 53 6f 6d 65 20 65 72 72 6f {...# Some erro
a690: 72 73 20 61 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 rs are normal...
a6a0: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 } elseif {$r
a6b0: 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 09 esult == 1} {...
a6c0: 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 # Handshake comp
a6d0: 6c 65 74 65 0a 09 09 66 69 6c 65 65 76 65 6e 74 lete...fileevent
a6e0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 22 0a $s readable "".
a6f0: 09 09 70 75 74 73 20 24 73 20 24 6d 70 0a 09 09 ..puts $s $mp...
a700: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a close $s.. }.
a710: 09 7d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 .}..proc accept
a720: 7b 6d 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 {mp s a p} {..
a730: 20 20 23 20 54 68 65 73 65 20 68 61 76 65 20 74 # These have t
a740: 6f 20 61 63 63 65 70 74 20 6e 6f 6e 2d 62 6c 6f o accept non-blo
a750: 63 6b 69 6e 67 2c 20 62 65 63 61 75 73 65 20 74 cking, because t
a760: 68 65 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a 09 he handshaking..
a770: 20 20 20 20 23 20 6f 72 64 65 72 20 69 73 6e 27 # order isn'
a780: 74 20 64 65 74 65 72 6d 69 6e 69 73 74 69 63 0a t deterministic.
a790: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
a7a0: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $s -blocking 0 -
a7b0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
a7c0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
a7d0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
a7e0: 68 61 6e 64 73 68 61 6b 65 20 24 73 20 24 6d 70 handshake $s $mp
a7f0: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 74 ]..}. }. t
a800: 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 72 74 66 69 ls::init -certfi
a810: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
a820: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a830: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
a840: 65 79 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 ey. set s1 [t
a850: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
a860: 74 65 53 65 72 76 65 72 49 50 20 34 30 30 33 5d teServerIP 4003]
a870: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
a880: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
a890: 53 65 72 76 65 72 49 50 20 34 30 30 34 5d 0a 20 ServerIP 4004].
a8a0: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
a8b0: 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 socket $remoteSe
a8c0: 72 76 65 72 49 50 20 34 30 30 35 5d 0a 20 20 20 rverIP 4005].
a8d0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
a8e0: 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 ppend l [gets $s
a8f0: 31 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 1] [gets $s1] [e
a900: 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 of $s1] [gets $s
a910: 32 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 2] [gets $s2] [e
a920: 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 of $s2] \..[gets
a930: 20 24 73 33 5d 20 5b 67 65 74 73 20 24 73 33 5d $s3] [gets $s3]
a940: 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 [eof $s3]. c
a950: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f lose $s1. clo
a960: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
a970: 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d $s3. sendCom
a980: 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 mand {..close $s
a990: 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 1..close $s2..cl
a9a0: 6f 73 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ose $s3. }.
a9b0: 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 set l.} {4003
a9c0: 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 20 34 {} 1 4004 {} 1 4
a9d0: 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 005 {} 1}..test
a9e0: 74 6c 73 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 tlsIO-11.9 {acce
a9f0: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
aa00: 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 r} {socket doTes
aa10: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
aa20: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 er} {. set s
aa30: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
aa40: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
aa50: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
aa60: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
aa70: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
aa80: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
aa90: 65 70 74 20 38 38 33 36 5d 0a 20 20 20 20 70 72 ept 8836]. pr
aaa0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
aab0: 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a } {expr 10 / 0}.
aac0: 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 proc bgerror
aad0: 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 args {..global
aae0: 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 x..set x $args.
aaf0: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 }. sendCer
ab00: 74 56 61 6c 75 65 73 0a 20 20 20 20 69 66 20 7b tValues. if {
ab10: 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d [catch {sendComm
ab20: 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 20 70 and {.. set p
ab30: 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 eername [fconfig
ab40: 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 ure $callerSocke
ab50: 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 t -peername]..
ab60: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
ab70: 63 6b 65 74 20 5c 0a 09 09 20 20 20 20 2d 63 65 cket \... -ce
ab80: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
ab90: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
aba0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
abb0: 65 6e 74 4b 65 79 20 5c 0a 09 09 20 20 20 20 5b entKey \... [
abc0: 6c 69 6e 64 65 78 20 24 70 65 65 72 6e 61 6d 65 lindex $peername
abd0: 20 30 5d 20 38 38 33 36 5d 0a 09 20 20 20 20 63 0] 8836].. c
abe0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 20 7d 7d lose $s. . }}
abf0: 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 msg]} {..close
ac00: 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 $s..error $msg.
ac10: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 69 6d }. set tim
ac20: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
ac30: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
ac40: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 "]. vwait x.
ac50: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
ac60: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
ac70: 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 $s. rename b
ac80: 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 gerror {}. se
ac90: 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 t x.} {{divide b
aca0: 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 74 y zero}}..test t
acb0: 6c 73 49 4f 2d 31 31 2e 31 30 20 7b 74 65 73 74 lsIO-11.10 {test
acc0: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
acd0: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
ace0: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
acf0: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
ad00: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
ad10: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
ad20: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
ad30: 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 10_12_test_serve
ad40: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
ad50: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
ad60: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
ad70: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
ad80: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
ad90: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
ada0: 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 8836]..proc acce
adb0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 pt {s a p} {clos
adc0: 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 e $s}. }.
add0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
ade0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
adf0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
ae00: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
ae10: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
ae20: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
ae30: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
ae40: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
ae50: 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e figure $s -peern
ae60: 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b ame]. set n [
ae70: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
ae80: 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 ockname]. set
ae90: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
aea0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 d l [lindex $p 2
aeb0: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b ] [llength $p] [
aec0: 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 llength $p].
aed0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e close $s. sen
aee0: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
aef0: 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 $socket10_12_tes
af00: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
af10: 74 20 6c 0a 7d 20 7b 38 38 33 36 20 33 20 33 7d t l.} {8836 3 3}
af20: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
af30: 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 11 {testing spur
af40: 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f ious events} {so
af50: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
af60: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
af70: 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 71 75 # remote equ
af80: 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 31 0a 20 ivalent of 9.1.
af90: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
afa0: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
afb0: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 5f d {..set socket_
afc0: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
afd0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
afe0: 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 accept \...-cer
aff0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
b000: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
b010: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
b020: 65 72 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f erKey 8836]..pro
b030: 63 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 7d 20 c handshake {s}
b040: 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 {.. if {[eof
b050: 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 $s]} {...close $
b060: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 s.. } elseif
b070: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 {[catch {tls::ha
b080: 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 75 ndshake $s} resu
b090: 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 lt]} {...# Some
b0a0: 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 errors are norma
b0b0: 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 l... } elseif
b0c0: 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 {$result == 1}
b0d0: 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 6b 65 20 {...# Handshake
b0e0: 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 complete...filee
b0f0: 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 vent $s writable
b100: 20 22 22 0a 09 09 61 66 74 65 72 20 31 30 30 20 ""...after 100
b110: 77 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 20 20 writesome $s..
b120: 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 }..}..proc acc
b130: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
b140: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
b150: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 -translation "a
b160: 75 74 6f 20 6c 66 22 0a 09 20 20 20 20 66 69 6c uto lf".. fil
b170: 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 eevent $s writab
b180: 6c 65 20 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 le [list handsha
b190: 6b 65 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 ke $s]..}..proc
b1a0: 77 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a writesome {s} {.
b1b0: 09 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
b1c0: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
b1d0: 6e 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 ncr i} {...puts
b1e0: 24 73 20 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d $s "line $i from
b1f0: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 22 0a remote server".
b200: 09 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 . }.. clos
b210: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
b220: 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 set len 0.
b230: 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 set spurious 0.
b240: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
b250: 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c proc readlittl
b260: 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 e {s} {..global
b270: 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 spurious done le
b280: 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 n..set l [read $
b290: 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e s 1]..if {[strin
b2a0: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 g length $l] ==
b2b0: 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 0} {.. if {![
b2c0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 eof $s]} {...inc
b2d0: 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 r spurious..
b2e0: 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 } else {...close
b2f0: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 $s...set done 1
b300: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
b310: 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 {.. incr len
b320: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
b330: 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 l]..}. }.
b340: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
b350: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
b360: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
b370: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
b380: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
b390: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
b3a0: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
b3b0: 0a 20 20 20 20 23 20 47 65 74 20 74 68 65 20 62 . # Get the b
b3c0: 75 66 66 65 72 69 6e 67 20 63 6f 72 72 65 63 74 uffering correct
b3d0: 65 64 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ed. fconfigur
b3e0: 65 20 24 63 20 2d 62 75 66 66 65 72 69 6e 67 20 e $c -buffering
b3f0: 6c 69 6e 65 0a 20 20 20 20 23 20 50 75 74 20 61 line. # Put a
b400: 20 62 79 74 65 20 69 6e 74 6f 20 74 68 65 20 63 byte into the c
b410: 6c 69 65 6e 74 20 70 69 70 65 20 74 6f 20 74 72 lient pipe to tr
b420: 69 67 67 65 72 20 54 4c 53 20 68 61 6e 64 73 68 igger TLS handsh
b430: 61 6b 69 6e 67 0a 20 20 20 20 70 75 74 73 20 24 aking. puts $
b440: 63 20 61 0a 20 20 20 20 66 69 6c 65 65 76 65 6e c a. fileeven
b450: 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 5b 6c t $c readable [l
b460: 69 73 74 20 72 65 61 64 6c 69 74 74 6c 65 20 24 ist readlittle $
b470: 63 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 c]. set timer
b480: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
b490: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
b4a0: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f t"]. vwait do
b4b0: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
b4c0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 cel $timer. s
b4d0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
b4e0: 65 20 24 73 6f 63 6b 65 74 5f 74 65 73 74 5f 73 e $socket_test_s
b4f0: 65 72 76 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 erver}. list
b500: 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d $spurious $len.}
b510: 20 7b 30 20 32 36 39 30 7d 0a 0a 74 65 73 74 20 {0 2690}..test
b520: 74 6c 73 49 4f 2d 31 31 2e 31 32 20 7b 74 65 73 tlsIO-11.12 {tes
b530: 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e ting EOF stickyn
b540: 65 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 ess} {unexplaine
b550: 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 dFailure socket
b560: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
b570: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 eServer} {. #
b580: 20 72 65 6d 6f 74 65 20 65 71 75 69 76 61 6c 65 remote equivale
b590: 6e 74 20 6f 66 20 39 2e 33 0a 20 20 20 20 23 20 nt of 9.3. #
b5a0: 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 HOBBS: never wor
b5b0: 6b 65 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 ked correctly.
b5c0: 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a set counter 0.
b5d0: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
b5e0: 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 proc count_up
b5f0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
b600: 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 65 ounter done afte
b610: 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 r_id..set l [get
b620: 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 s $s]..if {[eof
b630: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 $s]} {.. incr
b640: 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 66 counter.. if
b650: 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 {$counter > 9}
b660: 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f {...set done {EO
b670: 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 F is sticky}...a
b680: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 66 74 fter cancel $aft
b690: 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 er_id...close $s
b6a0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
b6b0: 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 64 5f . proc timed_
b6c0: 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c out {} {..global
b6d0: 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e c done..set don
b6e0: 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f e {timed_out, EO
b6f0: 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d F is not sticky}
b700: 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d ..close $c. }
b710: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
b720: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
b730: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
b740: 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 t10_14_test_serv
b750: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
b760: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
b770: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
b780: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b790: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
b7a0: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
b7b0: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 8836]..proc acc
b7c0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
b7d0: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
b7e0: 65 20 24 73 0a 09 20 20 20 20 61 66 74 65 72 20 e $s.. after
b7f0: 31 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 100 close $s..}.
b800: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 }. set c
b810: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
b820: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
b830: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
b840: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b850: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
b860: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
b870: 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 erIP 8836]. f
b880: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
b890: 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 able "count_up $
b8a0: 63 22 0a 20 20 20 20 73 65 74 20 61 66 74 65 72 c". set after
b8b0: 5f 69 64 20 5b 61 66 74 65 72 20 31 30 30 30 20 _id [after 1000
b8c0: 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 timed_out]. v
b8d0: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 wait done. se
b8e0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
b8f0: 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 $socket10_14_te
b900: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
b910: 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 et done.} {EOF i
b920: 73 20 73 74 69 63 6b 79 7d 0a 0a 74 65 73 74 20 s sticky}..test
b930: 74 6c 73 49 4f 2d 31 31 2e 31 33 20 7b 74 65 73 tlsIO-11.13 {tes
b940: 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 ting async write
b950: 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 , async flush, a
b960: 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b sync close} \..{
b970: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
b980: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
b990: 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 {. proc readi
b9a0: 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 t {s} {..global
b9b0: 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 count done..set
b9c0: 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 l [read $s]..inc
b9d0: 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 r count [string
b9e0: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b length $l]..if {
b9f0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 [eof $s]} {..
ba00: 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 close $s.. s
ba10: 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 et done 1..}.
ba20: 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 }. sendCertV
ba30: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
ba40: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 mmand {..set fir
ba50: 73 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 stblock [string
ba60: 72 65 70 65 61 74 20 61 20 33 31 5d 0a 09 73 65 repeat a 31]..se
ba70: 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 5b 73 t secondblock [s
ba80: 74 72 69 6e 67 20 72 65 70 65 61 74 20 62 20 36 tring repeat b 6
ba90: 35 35 33 35 5d 0a 09 73 65 74 20 6c 20 5b 74 6c 5535]..set l [tl
baa0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 s::socket \...-c
bab0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
bac0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
bad0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
bae0: 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 rverKey \...-ser
baf0: 76 65 72 20 61 63 63 65 70 74 20 38 38 34 35 5d ver accept 8845]
bb00: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
bb10: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
bb20: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
bb30: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
bb40: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 s -blocking 0 -t
bb50: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 ranslation lf -b
bb60: 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 20 uffersize 16384
bb70: 5c 0a 09 09 20 20 20 20 2d 62 75 66 66 65 72 69 \... -bufferi
bb80: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c ng line.. fil
bb90: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
bba0: 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 le "readable $s"
bbb0: 0a 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 61 62 ..}..proc readab
bbc0: 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 le {s} {.. se
bbd0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 t l [gets $s]..
bbe0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
bbf0: 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 readable {}..
bc00: 20 61 66 74 65 72 20 31 30 30 30 20 72 65 73 70 after 1000 resp
bc10: 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 ond $s..}..proc
bc20: 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 respond {s} {..
bc30: 20 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 global firstb
bc40: 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d lock.. puts -
bc50: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 nonewline $s $fi
bc60: 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 rstblock.. af
bc70: 74 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 ter 1000 writeda
bc80: 74 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 ta $s..}..proc w
bc90: 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 ritedata {s} {..
bca0: 20 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e global secon
bcb0: 64 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 dblock.. puts
bcc0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
bcd0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 secondblock..
bce0: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
bcf0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
bd00: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
bd10: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
bd20: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
bd30: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
bd40: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
bd50: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
bd60: 50 20 38 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e P 8845]. fcon
bd70: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
bd80: 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 ing 0 -translati
bd90: 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 on lf -buffering
bda0: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f line. set co
bdb0: 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 unt 0. puts $
bdc0: 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 s hello. file
bdd0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
bde0: 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 e "readit $s".
bdf0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
be00: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f er 10000 "set do
be10: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 ne timed_out"].
be20: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
be30: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
be40: 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f timer. sendCo
be50: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d mmand {close $l}
be60: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d . set count.}
be70: 20 36 35 35 36 36 0a 0a 70 72 6f 63 20 67 65 74 65566..proc get
be80: 64 61 74 61 20 7b 74 79 70 65 20 66 69 6c 65 7d data {type file}
be90: 20 7b 0a 20 20 20 20 23 20 52 65 61 64 20 68 61 {. # Read ha
bea0: 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 63 ndler on the acc
beb0: 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 20 20 epted socket..
bec0: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 67 global x. g
bed0: 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 20 20 20 lobal failed.
bee0: 20 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 set status [cat
bef0: 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 ch {read $file}
bf00: 64 61 74 61 5d 0a 20 20 20 20 69 66 20 7b 24 73 data]. if {$s
bf10: 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 73 tatus != 0} {..s
bf20: 65 74 20 78 20 22 72 65 61 64 20 66 61 69 6c 65 et x "read faile
bf30: 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 61 d, error was $da
bf40: 74 61 22 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f ta"..catch { clo
bf50: 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d se $file }. }
bf60: 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 elseif {[string
bf70: 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 compare {} $dat
bf80: 61 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c 73 65 a]} {. } else
bf90: 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 if {[fblocked $f
bfa0: 69 6c 65 5d 7d 20 7b 0a 20 20 20 20 7d 20 65 6c ile]} {. } el
bfb0: 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 seif {[eof $file
bfc0: 5d 7d 20 7b 0a 09 69 66 20 7b 24 66 61 69 6c 65 ]} {..if {$faile
bfd0: 64 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 d} {.. set x
bfe0: 22 24 74 79 70 65 20 73 6f 63 6b 65 74 20 77 61 "$type socket wa
bff0: 73 20 69 6e 68 65 72 69 74 65 64 22 0a 09 7d 20 s inherited"..}
c000: 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 else {.. set
c010: 78 20 22 24 74 79 70 65 20 73 6f 63 6b 65 74 20 x "$type socket
c020: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
c030: 64 22 0a 09 7d 0a 09 63 61 74 63 68 20 7b 20 63 d"..}..catch { c
c040: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 lose $file }.
c050: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 78 } else {..set x
c060: 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 {impossible cas
c070: 65 7d 0a 09 63 61 74 63 68 20 7b 20 63 6c 6f 73 e}..catch { clos
c080: 65 20 24 66 69 6c 65 20 7d 0a 20 20 20 20 7d 0a e $file }. }.
c090: 20 20 20 20 72 65 74 75 72 6e 0a 7d 0a 0a 74 65 return.}..te
c0a0: 73 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 st tlsIO-12.1 {t
c0b0: 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e esting inheritan
c0c0: 63 65 20 6f 66 20 73 65 72 76 65 72 20 73 6f 63 ce of server soc
c0d0: 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 kets} {socket ex
c0e0: 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 ec} {. makeFi
c0f0: 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 le {} script1.
c100: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
c110: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
c120: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
c130: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
c140: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
c150: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
c160: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
c170: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
c180: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
c190: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
c1a0: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
c1b0: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
c1c0: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
c1d0: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
c1e0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
c1f0: 20 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 # Script2 creat
c200: 65 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f es the server so
c210: 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 cket, launches s
c220: 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 cript1,. # wa
c230: 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e its a second, an
c240: 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 d exits. The se
c250: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c rver socket will
c260: 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c now. # be cl
c270: 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 osed unless scri
c280: 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 pt1 inherited it
c290: 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 ... set f [op
c2a0: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
c2b0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
c2c0: 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c set tclsh $::tcl
c2d0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 test::tcltest].
c2e0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 puts $f {..se
c2f0: 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 6e t auto_path [lin
c300: 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 20 sert $auto_path
c310: 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 74 0 [lindex [split
c320: 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a 22 $env(PATH) ";:"
c330: 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 65 20 72 ] 0]]..package r
c340: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
c350: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
c360: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
c370: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
c380: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
c390: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
c3a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
c3b0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
c3c0: 79 20 38 38 32 38 5c 5d 22 0a 20 20 20 20 70 75 y 8828\]". pu
c3d0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
c3e0: 63 65 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 cept { file addr
c3f0: 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 port } {.. c
c400: 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 lose $file..}..e
c410: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
c420: 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 t1 &..close $f..
c430: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
c440: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
c450: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
c460: 66 0a 09 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 f... # Launch
c470: 20 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 69 script2 and wai
c480: 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 t 5 seconds..
c490: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
c4a0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
c4b0: 32 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 30 2 &. after 50
c4c0: 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 00 { set ok_to_p
c4d0: 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 76 roceed 1 }. v
c4e0: 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 wait ok_to_proce
c4f0: 65 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 20 ed.. # If we
c500: 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 can still connec
c510: 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 2c t to the server,
c520: 20 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 the socket got
c530: 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 inherited...
c540: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
c550: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
c560: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
c570: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
c580: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
c590: 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 37 2e tKey \. . 127.
c5a0: 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 0.0.1 8828} msg]
c5b0: 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 76 } {..set x {serv
c5c0: 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f er socket was no
c5d0: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 t inherited}.
c5e0: 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 } else {..close
c5f0: 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 65 $msg..set x {se
c600: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
c610: 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d inherited}. }
c620: 0a 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 .. set x.} {s
c630: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
c640: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
c650: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 .test tlsIO-12.2
c660: 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 {testing inheri
c670: 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 tance of client
c680: 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 sockets} {socket
c690: 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b exec} {. mak
c6a0: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 eFile {} script1
c6b0: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
c6c0: 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 script2.. #
c6d0: 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 Script1 is just
c6e0: 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 a 10 second dela
c6f0: 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 65 y. If the serve
c700: 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 r socket. # i
c710: 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 s inherited, it
c720: 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 will be held ope
c730: 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 n for 10 seconds
c740: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
c750: 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 n script1 w].
c760: 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 puts $f {..afte
c770: 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 r 10000 exit..vw
c780: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
c790: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
c7a0: 20 20 20 20 23 20 53 63 72 69 70 74 32 20 6f 70 # Script2 op
c7b0: 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 73 ens the client s
c7c0: 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 73 ocket and writes
c7d0: 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 6e to it. It then
c7e0: 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 20 . # launches
c7f0: 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 74 script1 and exit
c800: 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c 64 s. If the child
c810: 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 74 process inherit
c820: 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c 69 ed the. # cli
c830: 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 ent socket, the
c840: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c socket will stil
c850: 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 l be open...
c860: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
c870: 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt2 w]. puts
c880: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c $f [list set tcl
c890: 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 sh $::tcltest::t
c8a0: 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 cltest]. puts
c8b0: 20 24 66 20 7b 0a 09 73 65 74 20 61 75 74 6f 5f $f {..set auto_
c8c0: 70 61 74 68 20 5b 6c 69 6e 73 65 72 74 20 24 61 path [linsert $a
c8d0: 75 74 6f 5f 70 61 74 68 20 30 20 5b 6c 69 6e 64 uto_path 0 [lind
c8e0: 65 78 20 5b 73 70 6c 69 74 20 24 65 6e 76 28 50 ex [split $env(P
c8f0: 41 54 48 29 20 22 3b 3a 22 5d 20 30 5d 5d 0a 09 ATH) ";:"] 0]]..
c900: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
c910: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
c920: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
c930: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
c940: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
c950: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
c960: 20 5c 0a 09 20 20 20 20 2d 6b 65 79 66 69 6c 65 \.. -keyfile
c970: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
c980: 30 2e 30 2e 31 20 38 38 32 39 5c 5d 22 0a 20 20 0.0.1 8829\]".
c990: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 78 65 puts $f {..exe
c9a0: 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 c $tclsh script1
c9b0: 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 &..puts $f test
c9c0: 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 ing..flush $f..a
c9d0: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
c9e0: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
c9f0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
ca00: 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 74 .. # Create t
ca10: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
ca20: 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 .. set server
ca30: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
ca40: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
ca50: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
ca60: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
ca70: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
ca80: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
ca90: 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 cept 8829]. p
caa0: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
cab0: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a e host port } {.
cac0: 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c 69 65 .# When the clie
cad0: 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 nt connects, est
cae0: 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 64 20 ablish the read
caf0: 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 handler..global
cb00: 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 server..close $s
cb10: 65 72 76 65 72 0a 09 66 63 6f 6e 66 69 67 75 72 erver..fconfigur
cb20: 65 20 24 66 69 6c 65 20 2d 62 6c 6f 63 6b 69 6e e $file -blockin
cb30: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 g 0..fileevent $
cb40: 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5b 6c file readable [l
cb50: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
cb60: 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 $file readable
cb70: 5c 0a 09 09 5b 6c 69 73 74 20 67 65 74 64 61 74 \...[list getdat
cb80: 61 20 63 6c 69 65 6e 74 5d 20 2d 62 75 66 66 65 a client] -buffe
cb90: 72 69 6e 67 20 6c 69 6e 65 5d 0a 09 72 65 74 75 ring line]..retu
cba0: 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 rn. }.. #
cbb0: 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 64 6f If the socket do
cbc0: 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 esn't hit end-of
cbd0: 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e -file in 5 secon
cbe0: 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 73 63 ds, the. # sc
cbf0: 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 6d 75 ript1 process mu
cc00: 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 st have inherite
cc10: 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 d the client...
cc20: 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a set failed 0.
cc30: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 5b after 5000 [
cc40: 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 64 20 list set failed
cc50: 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 1].. # Launch
cc60: 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f the script2 pro
cc70: 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 20 24 cess.. exec $
cc80: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
cc90: 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 st script2 &..
cca0: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 69 66 vwait x. if
ccb0: 20 7b 21 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76 {!$failed} {..v
ccc0: 77 61 69 74 20 66 61 69 6c 65 64 0a 20 20 20 20 wait failed.
ccd0: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 }. set x.} {c
cce0: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 lient socket was
ccf0: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
cd00: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 33 .test tlsIO-12.3
cd10: 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 {testing inheri
cd20: 74 61 6e 63 65 20 6f 66 20 61 63 63 65 70 74 65 tance of accepte
cd30: 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 d sockets} \..{s
cd40: 6f 63 6b 65 74 20 65 78 65 63 20 75 6e 69 78 4f ocket exec unixO
cd50: 6e 6c 79 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 nly} {. makeF
cd60: 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 ile {} script1.
cd70: 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 makeFile {} s
cd80: 63 72 69 70 74 32 0a 0a 20 20 20 20 73 65 74 20 cript2.. set
cd90: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 f [open script1
cda0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
cdb0: 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 ..after 10000 ex
cdc0: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
cdd0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
cde0: 65 20 24 66 0a 0a 20 20 20 20 73 65 74 20 66 20 e $f.. set f
cdf0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d [open script2 w]
ce00: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
ce10: 73 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a st set tclsh $::
ce20: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
ce30: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
ce40: 09 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b .set auto_path [
ce50: 6c 69 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 linsert $auto_pa
ce60: 74 68 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 th 0 [lindex [sp
ce70: 6c 69 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 lit $env(PATH) "
ce80: 3b 3a 22 5d 20 30 5d 5d 0a 09 70 61 63 6b 61 67 ;:"] 0]]..packag
ce90: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 e require tls.
cea0: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
ceb0: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
cec0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
ced0: 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ept \.. -cert
cee0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
cef0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
cf00: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
cf10: 72 4b 65 79 20 38 39 33 30 5c 5d 22 0a 20 20 20 rKey 8930\]".
cf20: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
cf30: 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 accept { file h
cf40: 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 ost port } {..
cf50: 20 20 67 6c 6f 62 61 6c 20 74 63 6c 73 68 0a 09 global tclsh..
cf60: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
cf70: 66 69 6c 65 20 2d 62 75 66 66 65 72 69 6e 67 20 file -buffering
cf80: 6c 69 6e 65 0a 09 20 20 20 20 70 75 74 73 20 24 line.. puts $
cf90: 66 69 6c 65 20 7b 74 65 73 74 20 64 61 74 61 20 file {test data
cfa0: 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 20 on socket}..
cfb0: 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 exec $tclsh scri
cfc0: 70 74 31 20 26 0a 09 20 20 20 20 61 66 74 65 72 pt1 &.. after
cfd0: 20 31 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 76 1000 exit..}..v
cfe0: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
cff0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
d000: 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 . # Launch th
d010: 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 e script2 proces
d020: 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f s and connect to
d030: 20 69 74 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f it. See how lo
d040: 6e 67 0a 20 20 20 20 23 20 74 68 65 20 73 6f 63 ng. # the soc
d050: 6b 65 74 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a ket stays open..
d060: 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 exec $::tclt
d070: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
d080: 69 70 74 32 20 26 0a 0a 20 20 20 20 61 66 74 65 ipt2 &.. afte
d090: 72 20 32 30 30 30 20 73 65 74 20 6f 6b 5f 74 6f r 2000 set ok_to
d0a0: 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 20 20 76 _proceed 1. v
d0b0: 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 wait ok_to_proce
d0c0: 65 64 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 74 ed.. set f [t
d0d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
d0e0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
d0f0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
d100: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
d110: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
d120: 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 39 33 127.0.0.1 893
d130: 30 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 0]. fconfigur
d140: 65 20 24 66 20 2d 62 75 66 66 65 72 69 6e 67 20 e $f -buffering
d150: 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 full -blocking 0
d160: 0a 20 20 20 20 23 20 57 65 20 6e 65 65 64 20 74 . # We need t
d170: 6f 20 70 75 74 20 61 20 62 79 74 65 20 69 6e 74 o put a byte int
d180: 6f 20 74 68 65 20 72 65 61 64 20 71 75 65 75 65 o the read queue
d190: 2c 20 6f 74 68 65 72 77 69 73 65 20 74 68 65 0a , otherwise the.
d1a0: 20 20 20 20 23 20 54 4c 53 20 68 61 6e 64 73 68 # TLS handsh
d1b0: 61 6b 65 20 64 6f 65 73 6e 27 74 20 66 69 6e 69 ake doesn't fini
d1c0: 73 68 0a 20 20 20 20 70 75 74 73 20 24 66 20 61 sh. puts $f a
d1d0: 3b 20 66 6c 75 73 68 20 24 66 0a 20 20 20 20 66 ; flush $f. f
d1e0: 69 6c 65 65 76 65 6e 74 20 24 66 20 72 65 61 64 ileevent $f read
d1f0: 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 able [list getda
d200: 74 61 20 61 63 63 65 70 74 65 64 20 24 66 5d 0a ta accepted $f].
d210: 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f . # If the so
d220: 63 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 cket is still op
d230: 65 6e 20 61 66 74 65 72 20 35 20 73 65 63 6f 6e en after 5 secon
d240: 64 73 2c 20 74 68 65 20 73 63 72 69 70 74 31 20 ds, the script1
d250: 70 72 6f 63 65 73 73 0a 20 20 20 20 23 20 6d 75 process. # mu
d260: 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 st have inherite
d270: 64 20 74 68 65 20 61 63 63 65 70 74 65 64 20 73 d the accepted s
d280: 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 ocket... set
d290: 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 failed 0. aft
d2a0: 65 72 20 35 30 30 30 20 73 65 74 20 66 61 69 6c er 5000 set fail
d2b0: 65 64 20 31 0a 0a 20 20 20 20 76 77 61 69 74 20 ed 1.. vwait
d2c0: 78 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 x. set x.} {a
d2d0: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 ccepted socket w
d2e0: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
d2f0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 }..test tlsIO-13
d300: 2e 31 20 7b 54 65 73 74 69 6e 67 20 75 73 65 20 .1 {Testing use
d310: 6f 66 20 73 68 61 72 65 64 20 73 6f 63 6b 65 74 of shared socket
d320: 20 62 65 74 77 65 65 6e 20 74 77 6f 20 74 68 72 between two thr
d330: 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 eads} \..{socket
d340: 20 74 65 73 74 74 68 72 65 61 64 7d 20 7b 0a 20 testthread} {.
d350: 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 # HOBBS: neve
d360: 72 20 74 65 73 74 65 64 0a 20 20 20 20 72 65 6d r tested. rem
d370: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
d380: 20 20 20 74 68 72 65 61 64 52 65 61 70 0a 0a 20 threadReap..
d390: 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 09 73 makeFile {..s
d3a0: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 5b 6c 69 et auto_path [li
d3b0: 6e 73 65 72 74 20 24 61 75 74 6f 5f 70 61 74 68 nsert $auto_path
d3c0: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 73 70 6c 69 0 [lindex [spli
d3d0: 74 20 24 65 6e 76 28 50 41 54 48 29 20 22 3b 3a t $env(PATH) ";:
d3e0: 22 5d 20 30 5d 5d 0a 20 20 20 20 09 70 61 63 6b "] 0]]. .pack
d3f0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
d400: 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 .set f [tls::soc
d410: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
d420: 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 pt 8828]..proc a
d430: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
d440: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 file
d450: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
d460: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
d470: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f . fco
d480: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
d490: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
d4a0: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
d4b0: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
d4c0: 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 al i.
d4d0: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
d4e0: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
d4f0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
d500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d510: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
d520: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
d530: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
d540: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
d550: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
d560: 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 se { ..
d570: 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 incr i.
d580: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
d590: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
d5a0: 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 }..}..set i 0..v
d5b0: 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 wait x..close $f
d5c0: 0a 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 61 ...# thread clea
d5d0: 6e 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 ns itself up...t
d5e0: 65 73 74 74 68 72 65 61 64 20 65 78 69 74 0a 20 estthread exit.
d5f0: 20 20 20 7d 20 73 63 72 69 70 74 0a 20 20 20 20 } script.
d600: 0a 20 20 20 20 23 20 63 72 65 61 74 65 20 61 20 . # create a
d610: 74 68 72 65 61 64 0a 20 20 20 20 73 65 74 20 73 thread. set s
d620: 65 72 76 65 72 74 68 72 65 61 64 20 5b 74 65 73 erverthread [tes
d630: 74 74 68 72 65 61 64 20 63 72 65 61 74 65 20 7b tthread create {
d640: 20 73 6f 75 72 63 65 20 73 63 72 69 70 74 20 7d source script }
d650: 20 5d 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 ]. update.
d660: 20 20 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 . after 100
d670: 30 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 0. set s [tls
d680: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
d690: 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 8828]. fco
d6a0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
d6b0: 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 ering line..
d6c0: 63 61 74 63 68 20 7b 0a 09 70 75 74 73 20 24 73 catch {..puts $s
d6d0: 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 "hello"..gets $
d6e0: 73 20 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 s result. }.
d6f0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
d700: 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 update.. afte
d710: 72 20 32 30 30 30 0a 20 20 20 20 6c 61 70 70 65 r 2000. lappe
d720: 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 72 65 61 nd result [threa
d730: 64 52 65 61 70 5d 0a 20 20 20 20 0a 20 20 20 20 dReap]. .
d740: 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 set result..} {h
d750: 65 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c 65 61 6e ello 1}..# clean
d760: 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d up.if {[string m
d770: 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d atch sock* $comm
d780: 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d andSocket] == 1}
d790: 20 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 6d 6d {. puts $comm
d7a0: 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 0a 20 andSocket exit.
d7b0: 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 6e 64 flush $command
d7c0: 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 20 7b Socket.}.catch {
d7d0: 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f close $commandSo
d7e0: 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 6c 6f cket}.catch {clo
d7f0: 73 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 43 68 se $remoteProcCh
d800: 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 an}.::tcltest::c
d810: 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 6c 75 73 leanupTests.flus
d820: 68 20 73 74 64 6f 75 74 0a 72 65 74 75 72 6e 0a h stdout.return.