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 35 20 32 30 30 30 2f 30 37 2f 32 37 20 30 .15 2000/07/27 0
0210: 31 3a 35 38 3a 31 39 20 68 6f 62 62 73 20 45 78 1:58:19 hobbs Ex
0220: 70 20 24 0a 0a 23 20 52 75 6e 6e 69 6e 67 20 73 p $..# Running s
0230: 6f 63 6b 65 74 20 74 65 73 74 73 20 77 69 74 68 ocket tests with
0240: 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 a remote server
0250: 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d :.# ------------
0260: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0270: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 23 --------------.#
0280: 20 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 69 .# Some tests i
0290: 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 64 65 n socket.test de
02a0: 70 65 6e 64 20 6f 6e 20 74 68 65 20 65 78 69 73 pend on the exis
02b0: 74 65 6e 63 65 20 6f 66 20 61 20 72 65 6d 6f 74 tence of a remot
02c0: 65 20 73 65 72 76 65 72 20 74 6f 0a 23 20 77 68 e server to.# wh
02d0: 69 63 68 20 74 68 65 79 20 63 6f 6e 6e 65 63 74 ich they connect
02e0: 2e 20 54 68 65 20 72 65 6d 6f 74 65 20 73 65 72 . The remote ser
02f0: 76 65 72 20 6d 75 73 74 20 62 65 20 61 6e 20 69 ver must be an i
0300: 6e 73 74 61 6e 63 65 20 6f 66 20 74 63 6c 74 65 nstance of tclte
0310: 73 74 20 61 6e 64 20 69 74 0a 23 20 6d 75 73 74 st and it.# must
0320: 20 72 75 6e 20 74 68 65 20 73 63 72 69 70 74 20 run the script
0330: 66 6f 75 6e 64 20 69 6e 20 74 68 65 20 66 69 6c found in the fil
0340: 65 20 22 72 65 6d 6f 74 65 2e 74 63 6c 22 20 69 e "remote.tcl" i
0350: 6e 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 n this directory
0360: 2e 20 59 6f 75 0a 23 20 63 61 6e 20 73 74 61 72 . You.# can star
0370: 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 t the remote ser
0380: 76 65 72 20 6f 6e 20 61 6e 79 20 6d 61 63 68 69 ver on any machi
0390: 6e 65 20 72 65 61 63 68 61 62 6c 65 20 66 72 6f ne reachable fro
03a0: 6d 20 74 68 65 20 6d 61 63 68 69 6e 65 20 6f 6e m the machine on
03b0: 0a 23 20 77 68 69 63 68 20 79 6f 75 20 77 61 6e .# which you wan
03c0: 74 20 74 6f 20 72 75 6e 20 74 68 65 20 73 6f 63 t to run the soc
03d0: 6b 65 74 20 74 65 73 74 73 2c 20 62 79 20 69 73 ket tests, by is
03e0: 73 75 69 6e 67 3a 0a 23 20 0a 23 20 20 20 20 20 suing:.# .#
03f0: 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 tcltest remote.t
0400: 63 6c 20 2d 70 6f 72 74 20 38 30 34 38 09 23 20 cl -port 8048.#
0410: 4f 72 20 63 68 6f 6f 73 65 20 61 6e 6f 74 68 65 Or choose anothe
0420: 72 20 70 6f 72 74 20 6e 75 6d 62 65 72 2e 0a 23 r port number..#
0430: 20 0a 23 20 49 66 20 74 68 65 20 6d 61 63 68 69 .# If the machi
0440: 6e 65 20 79 6f 75 20 61 72 65 20 72 75 6e 6e 69 ne you are runni
0450: 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 ng the remote se
0460: 72 76 65 72 20 6f 6e 20 68 61 73 20 73 65 76 65 rver on has seve
0470: 72 61 6c 20 49 50 0a 23 20 69 6e 74 65 72 66 61 ral IP.# interfa
0480: 63 65 73 2c 20 79 6f 75 20 63 61 6e 20 63 68 6f ces, you can cho
0490: 6f 73 65 20 77 68 69 63 68 20 69 6e 74 65 72 66 ose which interf
04a0: 61 63 65 20 74 68 65 20 73 65 72 76 65 72 20 6c ace the server l
04b0: 69 73 74 65 6e 73 20 6f 6e 20 66 6f 72 0a 23 20 istens on for.#
04c0: 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 62 79 20 73 connections by s
04d0: 70 65 63 69 66 79 69 6e 67 20 74 68 65 20 2d 61 pecifying the -a
04e0: 64 64 72 65 73 73 20 63 6f 6d 6d 61 6e 64 20 6c ddress command l
04f0: 69 6e 65 20 66 6c 61 67 2c 20 73 6f 3a 0a 23 20 ine flag, so:.#
0500: 0a 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 .# tcltest r
0510: 65 6d 6f 74 65 2e 74 63 6c 20 2d 61 64 64 72 65 emote.tcl -addre
0520: 73 73 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e ss your.machine.
0530: 63 6f 6d 0a 23 20 0a 23 20 54 68 65 73 65 20 6f com.# .# These o
0540: 70 74 69 6f 6e 73 20 63 61 6e 20 61 6c 73 6f 20 ptions can also
0550: 62 65 20 73 65 74 20 62 79 20 65 6e 76 69 72 6f be set by enviro
0560: 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 2e nment variables.
0570: 20 4f 6e 20 55 6e 69 78 2c 20 79 6f 75 20 63 61 On Unix, you ca
0580: 6e 0a 23 20 74 79 70 65 20 74 68 65 73 65 20 63 n.# type these c
0590: 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 73 ommands to the s
05a0: 68 65 6c 6c 20 66 72 6f 6d 20 77 68 69 63 68 20 hell from which
05b0: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
05c0: 72 20 69 73 20 73 74 61 72 74 65 64 3a 0a 23 20 r is started:.#
05d0: 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 .# shell% se
05e0: 74 65 6e 76 20 73 65 72 76 65 72 50 6f 72 74 20 tenv serverPort
05f0: 38 30 34 38 0a 23 20 20 20 20 20 73 68 65 6c 6c 8048.# shell
0600: 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 41 % setenv serverA
0610: 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 ddress your.mach
0620: 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 61 6e 64 ine.com.# .# and
0630: 20 73 75 62 73 65 71 75 65 6e 74 6c 79 20 79 6f subsequently yo
0640: 75 20 63 61 6e 20 73 74 61 72 74 20 74 68 65 20 u can start the
0650: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 77 69 remote server wi
0660: 74 68 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c th:.# .# tcl
0670: 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 0a test remote.tcl.
0680: 23 20 0a 23 20 74 6f 20 68 61 76 65 20 69 74 20 # .# to have it
0690: 6c 69 73 74 65 6e 20 6f 6e 20 70 6f 72 74 20 38 listen on port 8
06a0: 30 34 38 20 6f 6e 20 74 68 65 20 69 6e 74 65 72 048 on the inter
06b0: 66 61 63 65 20 79 6f 75 72 2e 6d 61 63 68 69 6e face your.machin
06c0: 65 2e 63 6f 6d 2e 0a 23 20 20 20 20 20 0a 23 20 e.com..# .#
06d0: 57 68 65 6e 20 74 68 65 20 73 65 72 76 65 72 20 When the server
06e0: 73 74 61 72 74 73 2c 20 69 74 20 70 72 69 6e 74 starts, it print
06f0: 73 20 6f 75 74 20 61 20 64 65 74 61 69 6c 65 64 s out a detailed
0700: 20 6d 65 73 73 61 67 65 20 63 6f 6e 74 61 69 6e message contain
0710: 69 6e 67 20 69 74 73 0a 23 20 63 6f 6e 66 69 67 ing its.# config
0720: 75 72 61 74 69 6f 6e 20 69 6e 66 6f 72 6d 61 74 uration informat
0730: 69 6f 6e 2c 20 61 6e 64 20 69 74 20 77 69 6c 6c ion, and it will
0740: 20 62 6c 6f 63 6b 20 75 6e 74 69 6c 20 6b 69 6c block until kil
0750: 6c 65 64 20 77 69 74 68 20 61 20 43 74 72 6c 2d led with a Ctrl-
0760: 43 2e 0a 23 20 4f 6e 63 65 20 74 68 65 20 72 65 C..# Once the re
0770: 6d 6f 74 65 20 73 65 72 76 65 72 20 65 78 69 73 mote server exis
0780: 74 73 2c 20 79 6f 75 20 63 61 6e 20 72 75 6e 20 ts, you can run
0790: 74 68 65 20 74 65 73 74 73 20 69 6e 20 73 6f 63 the tests in soc
07a0: 6b 65 74 2e 74 65 73 74 20 77 69 74 68 0a 23 20 ket.test with.#
07b0: 74 68 65 20 73 65 72 76 65 72 20 62 79 20 73 65 the server by se
07c0: 74 74 69 6e 67 20 74 77 6f 20 54 63 6c 20 76 61 tting two Tcl va
07d0: 72 69 61 62 6c 65 73 3a 0a 23 20 0a 23 20 20 20 riables:.# .#
07e0: 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 65 % set remoteSe
07f0: 72 76 65 72 49 50 20 3c 6e 61 6d 65 20 6f 72 20 rverIP <name or
0800: 61 64 64 72 65 73 73 20 6f 66 20 6d 61 63 68 69 address of machi
0810: 6e 65 20 6f 6e 20 77 68 69 63 68 20 73 65 72 76 ne on which serv
0820: 65 72 20 72 75 6e 73 3e 0a 23 20 20 20 20 20 25 er runs>.# %
0830: 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 set remoteServe
0840: 72 50 6f 72 74 20 38 30 34 38 0a 23 20 0a 23 20 rPort 8048.# .#
0850: 54 68 65 73 65 20 76 61 72 69 61 62 6c 65 73 20 These variables
0860: 61 72 65 20 61 6c 73 6f 20 73 65 74 74 61 62 6c are also settabl
0870: 65 20 66 72 6f 6d 20 74 68 65 20 65 6e 76 69 72 e from the envir
0880: 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 55 6e 69 78 2c onment. On Unix,
0890: 20 79 6f 75 20 63 61 6e 3a 0a 23 20 0a 23 20 20 you can:.# .#
08a0: 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 shell% setenv
08b0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
08c0: 6d 61 63 68 69 6e 65 2e 77 68 65 72 65 2e 73 65 machine.where.se
08d0: 72 76 65 72 2e 72 75 6e 73 0a 23 20 20 20 20 20 rver.runs.#
08e0: 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 72 65 shell% setenv re
08f0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 38 moteServerPort 8
0900: 30 34 38 0a 23 20 0a 23 20 54 68 65 20 70 72 65 048.# .# The pre
0910: 61 6d 62 6c 65 20 6f 66 20 74 68 65 20 73 6f 63 amble of the soc
0920: 6b 65 74 2e 74 65 73 74 20 66 69 6c 65 20 63 68 ket.test file ch
0930: 65 63 6b 73 20 74 6f 20 73 65 65 20 69 66 20 74 ecks to see if t
0940: 68 65 20 76 61 72 69 61 62 6c 65 73 20 61 72 65 he variables are
0950: 20 73 65 74 0a 23 20 65 69 74 68 65 72 20 69 6e set.# either in
0960: 20 54 63 6c 20 6f 72 20 69 6e 20 74 68 65 20 65 Tcl or in the e
0970: 6e 76 69 72 6f 6e 6d 65 6e 74 3b 20 69 66 20 74 nvironment; if t
0980: 68 65 79 20 61 72 65 2c 20 69 74 20 61 74 74 65 hey are, it atte
0990: 6d 70 74 73 20 74 6f 20 63 6f 6e 6e 65 63 74 20 mpts to connect
09a0: 74 6f 0a 23 20 74 68 65 20 73 65 72 76 65 72 2e to.# the server.
09b0: 20 49 66 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 If the connecti
09c0: 6f 6e 20 69 73 20 73 75 63 63 65 73 73 66 75 6c on is successful
09d0: 2c 20 74 68 65 20 74 65 73 74 73 20 75 73 69 6e , the tests usin
09e0: 67 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 g the remote.# s
09f0: 65 72 76 65 72 20 77 69 6c 6c 20 62 65 20 70 65 erver will be pe
0a00: 72 66 6f 72 6d 65 64 3b 20 6f 74 68 65 72 77 69 rformed; otherwi
0a10: 73 65 2c 20 69 74 20 77 69 6c 6c 20 61 74 74 65 se, it will atte
0a20: 6d 70 74 20 74 6f 20 73 74 61 72 74 20 74 68 65 mpt to start the
0a30: 20 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 remote.# server
0a40: 20 28 76 69 61 20 65 78 65 63 29 20 6f 6e 20 70 (via exec) on p
0a50: 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 73 75 latforms that su
0a60: 70 70 6f 72 74 20 74 68 69 73 2c 20 6f 6e 20 74 pport this, on t
0a70: 68 65 20 6c 6f 63 61 6c 20 68 6f 73 74 2c 0a 23 he local host,.#
0a80: 20 6c 69 73 74 65 6e 69 6e 67 20 61 74 20 70 6f listening at po
0a90: 72 74 20 38 30 34 38 2e 20 49 66 20 61 6c 6c 20 rt 8048. If all
0aa0: 66 61 69 6c 73 2c 20 61 20 6d 65 73 73 61 67 65 fails, a message
0ab0: 20 69 73 20 70 72 69 6e 74 65 64 20 61 6e 64 20 is printed and
0ac0: 74 68 65 20 74 65 73 74 73 0a 23 20 75 73 69 6e the tests.# usin
0ad0: 67 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 g the remote ser
0ae0: 76 65 72 20 61 72 65 20 6e 6f 74 20 70 65 72 66 ver are not perf
0af0: 6f 72 6d 65 64 2e 0a 0a 70 72 6f 63 20 64 70 75 ormed...proc dpu
0b00: 74 73 20 7b 6d 73 67 7d 20 7b 20 72 65 74 75 72 ts {msg} { retur
0b10: 6e 20 3b 20 70 75 74 73 20 73 74 64 65 72 72 20 n ; puts stderr
0b20: 24 6d 73 67 20 3b 20 66 6c 75 73 68 20 73 74 64 $msg ; flush std
0b30: 65 72 72 20 7d 0a 0a 69 66 20 7b 5b 6c 73 65 61 err }..if {[lsea
0b40: 72 63 68 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 rch [namespace c
0b50: 68 69 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c 74 65 hildren] ::tclte
0b60: 73 74 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 20 20 st] == -1} {.
0b70: 20 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 package require
0b80: 20 74 63 6c 74 65 73 74 0a 20 20 20 20 6e 61 6d tcltest. nam
0b90: 65 73 70 61 63 65 20 69 6d 70 6f 72 74 20 2d 66 espace import -f
0ba0: 6f 72 63 65 20 3a 3a 74 63 6c 74 65 73 74 3a 3a orce ::tcltest::
0bb0: 2a 0a 7d 0a 0a 23 20 4c 6f 61 64 20 74 68 65 20 *.}..# Load the
0bc0: 74 6c 73 20 70 61 63 6b 61 67 65 0a 0a 70 61 63 tls package..pac
0bd0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
0be0: 0a 0a 73 65 74 20 74 6c 73 53 65 72 76 65 72 50 ..set tlsServerP
0bf0: 6f 72 74 20 38 30 34 38 0a 0a 23 20 53 70 65 63 ort 8048..# Spec
0c00: 69 66 79 20 77 68 65 72 65 20 74 68 65 20 63 65 ify where the ce
0c10: 72 74 69 66 69 63 61 74 65 73 20 61 72 65 0a 0a rtificates are..
0c20: 73 65 74 20 63 65 72 74 73 44 69 72 09 5b 66 69 set certsDir.[fi
0c30: 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 le join [file di
0c40: 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 rname [info scri
0c50: 70 74 5d 5d 20 63 65 72 74 73 5d 0a 73 65 74 20 pt]] certs].set
0c60: 73 65 72 76 65 72 43 65 72 74 09 5b 66 69 6c 65 serverCert.[file
0c70: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
0c80: 73 65 72 76 65 72 2e 70 65 6d 5d 0a 73 65 74 20 server.pem].set
0c90: 63 6c 69 65 6e 74 43 65 72 74 09 5b 66 69 6c 65 clientCert.[file
0ca0: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
0cb0: 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 65 74 20 client.pem].set
0cc0: 63 61 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 caCert.[file joi
0cd0: 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 63 65 n $certsDir cace
0ce0: 72 74 2e 70 65 6d 5d 0a 73 65 74 20 73 65 72 76 rt.pem].set serv
0cf0: 65 72 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e erKey.[file join
0d00: 20 24 63 65 72 74 73 44 69 72 20 73 6b 65 79 2e $certsDir skey.
0d10: 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e 74 4b pem].set clientK
0d20: 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 ey.[file join $c
0d30: 65 72 74 73 44 69 72 20 63 6b 65 79 2e 70 65 6d ertsDir ckey.pem
0d40: 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 ]..# Some tests
0d50: 72 65 71 75 69 72 65 20 74 68 65 20 74 65 73 74 require the test
0d60: 74 68 72 65 61 64 20 61 6e 64 20 65 78 65 63 20 thread and exec
0d70: 63 6f 6d 6d 61 6e 64 73 0a 0a 73 65 74 20 3a 3a commands..set ::
0d80: 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e tcltest::testCon
0d90: 73 74 72 61 69 6e 74 73 28 74 65 73 74 74 68 72 straints(testthr
0da0: 65 61 64 29 20 5c 0a 09 5b 65 78 70 72 20 7b 5b ead) \..[expr {[
0db0: 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 74 65 info commands te
0dc0: 73 74 74 68 72 65 61 64 5d 20 21 3d 20 7b 7d 7d stthread] != {}}
0dd0: 5d 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a ].set ::tcltest:
0de0: 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 :testConstraints
0df0: 28 65 78 65 63 29 20 5b 65 78 70 72 20 7b 5b 69 (exec) [expr {[i
0e00: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 nfo commands exe
0e10: 63 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 c] != {}}]..#.#
0e20: 49 66 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 If remoteServerI
0e30: 50 20 6f 72 20 72 65 6d 6f 74 65 53 65 72 76 65 P or remoteServe
0e40: 72 50 6f 72 74 20 61 72 65 20 6e 6f 74 20 73 65 rPort are not se
0e50: 74 2c 20 63 68 65 63 6b 20 69 6e 20 74 68 65 0a t, check in the.
0e60: 23 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 # environment va
0e70: 72 69 61 62 6c 65 73 20 66 6f 72 20 65 78 74 65 riables for exte
0e80: 72 6e 61 6c 6c 79 20 73 65 74 20 76 61 6c 75 65 rnally set value
0e90: 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f s..#..if {![info
0ea0: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 exists remoteSe
0eb0: 72 76 65 72 49 50 5d 7d 20 7b 0a 20 20 20 20 69 rverIP]} {. i
0ec0: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0ed0: 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 env(remoteServer
0ee0: 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d IP)]} {..set rem
0ef0: 6f 74 65 53 65 72 76 65 72 49 50 20 24 65 6e 76 oteServerIP $env
0f00: 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 (remoteServerIP)
0f10: 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 . }.}.if {![i
0f20: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 nfo exists remot
0f30: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a eServerPort]} {.
0f40: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
0f50: 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 ists env(remoteS
0f60: 65 72 76 65 72 50 6f 72 74 29 5d 7d 20 7b 0a 09 erverPort)]} {..
0f70: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
0f80: 50 6f 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 65 Port $env(remote
0f90: 53 65 72 76 65 72 50 6f 72 74 29 0a 20 20 20 20 ServerPort).
0fa0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
0fb0: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 if {[info exist
0fc0: 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 s remoteServerIP
0fd0: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 ]} {.. set re
0fe0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 moteServerPort $
0ff0: 74 6c 73 53 65 72 76 65 72 50 6f 72 74 0a 20 20 tlsServerPort.
1000: 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 7d 0a }. }.}.
1010: 0a 70 72 6f 63 20 64 6f 5f 68 61 6e 64 73 68 61 .proc do_handsha
1020: 6b 65 20 7b 73 20 7b 74 79 70 65 20 72 65 61 64 ke {s {type read
1030: 61 62 6c 65 7d 20 7b 63 6d 64 20 7b 7d 7d 20 61 able} {cmd {}} a
1040: 72 67 73 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b rgs} {. if {[
1050: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 63 6c 6f 73 eof $s]} {..clos
1060: 65 20 24 73 0a 09 64 70 75 74 73 20 22 68 61 6e e $s..dputs "han
1070: 64 73 68 61 6b 65 3a 20 65 6f 66 22 0a 09 73 65 dshake: eof"..se
1080: 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 68 61 6b 65 t ::do_handshake
1090: 20 22 65 6f 66 22 0a 20 20 20 20 7d 20 65 6c 73 "eof". } els
10a0: 65 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 eif {[catch {tls
10b0: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 ::handshake $s}
10c0: 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 23 20 53 6f result]} {..# So
10d0: 6d 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f me errors are no
10e0: 72 6d 61 6c 2e 0a 09 64 70 75 74 73 20 22 68 61 rmal...dputs "ha
10f0: 6e 64 73 68 61 6b 65 3a 20 24 72 65 73 75 6c 74 ndshake: $result
1100: 22 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b ". } elseif {
1110: 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a $result == 1} {.
1120: 09 23 20 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d .# Handshake com
1130: 70 6c 65 74 65 0a 09 69 66 20 7b 5b 6c 6c 65 6e plete..if {[llen
1140: 67 74 68 20 24 61 72 67 73 5d 7d 20 7b 20 65 76 gth $args]} { ev
1150: 61 6c 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 al fconfigure $s
1160: 20 24 61 72 67 73 20 7d 0a 09 69 66 20 7b 24 63 $args }..if {$c
1170: 6d 64 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 md == ""} {..
1180: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 24 74 fileevent $s $t
1190: 79 70 65 20 22 22 0a 09 7d 20 65 6c 73 65 20 7b ype ""..} else {
11a0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
11b0: 24 73 20 24 74 79 70 65 20 22 24 63 6d 64 20 24 $s $type "$cmd $
11c0: 73 22 0a 09 7d 0a 09 64 70 75 74 73 20 22 68 61 s"..}..dputs "ha
11d0: 6e 64 73 68 61 6b 65 3a 20 63 6f 6d 70 6c 65 74 ndshake: complet
11e0: 65 22 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 61 6e e"..set ::do_han
11f0: 64 73 68 61 6b 65 20 22 63 6f 6d 70 6c 65 74 65 dshake "complete
1200: 22 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 ". } else {..
1210: 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 6b 65 dputs "handshake
1220: 3a 20 69 6e 20 70 72 6f 67 72 65 73 73 22 0a 20 : in progress".
1230: 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 }.}..#.# Chec
1240: 6b 20 69 66 20 77 65 27 72 65 20 73 75 70 70 6f k if we're suppo
1250: 73 65 64 20 74 6f 20 64 6f 20 74 65 73 74 73 20 sed to do tests
1260: 61 67 61 69 6e 73 74 20 74 68 65 20 72 65 6d 6f against the remo
1270: 74 65 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 te server.#..set
1280: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
1290: 74 65 53 65 72 76 65 72 20 31 0a 69 66 20 7b 21 teServer 1.if {!
12a0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
12b0: 6f 74 65 53 65 72 76 65 72 49 50 5d 20 26 26 20 oteServerIP] &&
12c0: 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 ($tcl_platform(p
12d0: 6c 61 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 latform) != "mac
12e0: 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 intosh")} {.
12f0: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
1300: 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 IP 127.0.0.1.}.i
1310: 66 20 7b 28 24 64 6f 54 65 73 74 73 57 69 74 68 f {($doTestsWith
1320: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 RemoteServer ==
1330: 31 29 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 1) && (![info ex
1340: 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 ists remoteServe
1350: 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 rPort])} {. s
1360: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 et remoteServerP
1370: 6f 72 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f ort $tlsServerPo
1380: 72 74 0a 7d 0a 0a 23 20 41 74 74 65 6d 70 74 20 rt.}..# Attempt
1390: 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 61 20 to connect to a
13a0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 69 66 remote server if
13b0: 20 6f 6e 65 20 69 73 20 61 6c 72 65 61 64 79 20 one is already
13c0: 72 75 6e 6e 69 6e 67 2e 20 49 66 20 69 74 0a 23 running. If it.#
13d0: 20 69 73 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 is not running
13e0: 6f 72 20 66 6f 72 20 73 6f 6d 65 20 6f 74 68 65 or for some othe
13f0: 72 20 72 65 61 73 6f 6e 20 74 68 65 20 63 6f 6e r reason the con
1400: 6e 65 63 74 20 66 61 69 6c 73 2c 20 61 74 74 65 nect fails, atte
1410: 6d 70 74 20 74 6f 0a 23 20 73 74 61 72 74 20 74 mpt to.# start t
1420: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
1430: 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f on the local ho
1440: 73 74 20 6c 69 73 74 65 6e 69 6e 67 20 6f 6e 20 st listening on
1450: 70 6f 72 74 20 38 30 34 38 2e 20 54 68 69 73 0a port 8048. This.
1460: 23 20 69 73 20 6f 6e 6c 79 20 64 6f 6e 65 20 6f # is only done o
1470: 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 n platforms that
1480: 20 73 75 70 70 6f 72 74 20 65 78 65 63 20 28 69 support exec (i
1490: 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 68 65 20 4d .e. not on the M
14a0: 61 63 29 2e 20 4f 6e 0a 23 20 70 6c 61 74 66 6f ac). On.# platfo
14b0: 72 6d 73 20 74 68 61 74 20 64 6f 20 6e 6f 74 20 rms that do not
14c0: 73 75 70 70 6f 72 74 20 65 78 65 63 2c 20 74 68 support exec, th
14d0: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 e remote server
14e0: 6d 75 73 74 20 62 65 20 73 74 61 72 74 65 64 0a must be started.
14f0: 23 20 62 79 20 74 68 65 20 75 73 65 72 20 62 65 # by the user be
1500: 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 fore running the
1510: 20 74 65 73 74 73 2e 0a 0a 73 65 74 20 72 65 6d tests...set rem
1520: 6f 74 65 50 72 6f 63 43 68 61 6e 20 22 22 0a 73 oteProcChan "".s
1530: 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 et commandSocket
1540: 20 22 22 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 "".if {$doTests
1550: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
1560: 7d 20 7b 0a 20 20 20 20 63 61 74 63 68 20 7b 63 } {. catch {c
1570: 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 lose $commandSoc
1580: 6b 65 74 7d 0a 20 20 20 20 69 66 20 7b 5b 63 61 ket}. if {[ca
1590: 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 tch {set command
15a0: 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 Socket [tls::soc
15b0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
15c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
15d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
15e0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
15f0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
1600: 6f 74 65 53 65 72 76 65 72 49 50 20 24 72 65 6d oteServerIP $rem
1610: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d oteServerPort]}]
1620: 20 21 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 != 0} {..if {[i
1630: 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 nfo commands exe
1640: 63 5d 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 c] == ""} {..
1650: 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 set noRemoteTes
1660: 74 52 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 tReason "can't e
1670: 78 65 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f xec".. set do
1680: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1690: 65 72 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 erver 0..} else
16a0: 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 {.. set remot
16b0: 65 53 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e eServerIP 127.0.
16c0: 30 2e 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 0.1.. set rem
16d0: 6f 74 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f oteFile [file jo
16e0: 69 6e 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e in [pwd] remote.
16f0: 74 63 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 tcl].. if {[c
1700: 61 74 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 atch {set remote
1710: 50 72 6f 63 43 68 61 6e 20 5c 0a 09 09 20 20 20 ProcChan \...
1720: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
1730: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
1740: 73 74 20 24 72 65 6d 6f 74 65 46 69 6c 65 20 5c st $remoteFile \
1750: 0a 09 09 20 20 20 20 2d 73 65 72 76 65 72 49 73 ... -serverIs
1760: 53 69 6c 65 6e 74 20 2d 70 6f 72 74 20 24 72 65 Silent -port $re
1770: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 5c moteServerPort \
1780: 0a 09 09 20 20 20 20 2d 61 64 64 72 65 73 73 20 ... -address
1790: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d $remoteServerIP]
17a0: 22 20 77 2b 5d 7d 20 6d 73 67 5d 20 3d 3d 20 30 " w+]} msg] == 0
17b0: 7d 20 7b 0a 09 09 61 66 74 65 72 20 31 30 30 30 } {...after 1000
17c0: 0a 09 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 ...if {[catch {s
17d0: 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 et commandSocket
17e0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
17f0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
1800: 09 09 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c ...-certfile $cl
1810: 69 65 6e 74 43 65 72 74 20 2d 6b 65 79 66 69 6c ientCert -keyfil
1820: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
1830: 09 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 ..$remoteServerI
1840: 50 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 P $remoteServerP
1850: 6f 72 74 5d 7d 20 6d 73 67 5d 20 3d 3d 20 30 7d ort]} msg] == 0}
1860: 20 7b 0a 09 09 20 20 20 20 66 63 6f 6e 66 69 67 {... fconfig
1870: 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ure $commandSock
1880: 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 et -translation
1890: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
18a0: 6c 69 6e 65 0a 09 09 7d 20 65 6c 73 65 20 7b 0a line...} else {.
18b0: 09 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f .. set noRemo
18c0: 74 65 54 65 73 74 52 65 61 73 6f 6e 20 24 6d 73 teTestReason $ms
18d0: 67 0a 09 09 20 20 20 20 73 65 74 20 64 6f 54 65 g... set doTe
18e0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
18f0: 76 65 72 20 30 0a 09 09 7d 0a 09 20 20 20 20 7d ver 0...}.. }
1900: 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 6e 6f else {...set no
1910: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
1920: 20 22 24 6d 73 67 20 24 3a 3a 74 63 6c 74 65 73 "$msg $::tcltes
1930: 74 3a 3a 74 63 6c 74 65 73 74 22 0a 09 09 73 65 t::tcltest"...se
1940: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
1950: 6f 74 65 53 65 72 76 65 72 20 30 0a 09 20 20 20 oteServer 0..
1960: 20 7d 0a 09 7d 0a 20 20 20 20 7d 20 65 6c 73 65 }..}. } else
1970: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
1980: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 commandSocket -t
1990: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 ranslation crlf
19a0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
19b0: 20 20 20 20 7d 0a 7d 0a 0a 23 20 53 6f 6d 65 20 }.}..# Some
19c0: 74 65 73 74 73 20 61 72 65 20 72 75 6e 20 6f 6e tests are run on
19d0: 6c 79 20 69 66 20 77 65 20 61 72 65 20 64 6f 69 ly if we are doi
19e0: 6e 67 20 74 65 73 74 69 6e 67 20 61 67 61 69 6e ng testing again
19f0: 73 74 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 st a remote serv
1a00: 65 72 2e 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 er..set ::tcltes
1a10: 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e t::testConstrain
1a20: 74 73 28 64 6f 54 65 73 74 73 57 69 74 68 52 65 ts(doTestsWithRe
1a30: 6d 6f 74 65 53 65 72 76 65 72 29 20 24 64 6f 54 moteServer) $doT
1a40: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1a50: 72 76 65 72 0a 69 66 20 7b 24 64 6f 54 65 73 74 rver.if {$doTest
1a60: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
1a70: 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 69 66 r == 0} {. if
1a80: 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 74 20 {[string first
1a90: 73 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 76 65 s $::tcltest::ve
1aa0: 72 62 6f 73 65 5d 20 21 3d 20 2d 31 7d 20 7b 0a rbose] != -1} {.
1ab0: 20 20 20 20 09 70 75 74 73 20 22 53 6b 69 70 70 .puts "Skipp
1ac0: 69 6e 67 20 74 65 73 74 73 20 77 69 74 68 20 72 ing tests with r
1ad0: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 20 53 65 emote server. Se
1ae0: 65 20 74 65 73 74 73 2f 73 6f 63 6b 65 74 2e 74 e tests/socket.t
1af0: 65 73 74 20 66 6f 72 22 0a 09 70 75 74 73 20 22 est for"..puts "
1b00: 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 68 information on h
1b10: 6f 77 20 74 6f 20 72 75 6e 20 72 65 6d 6f 74 65 ow to run remote
1b20: 20 73 65 72 76 65 72 2e 22 0a 09 70 75 74 73 20 server."..puts
1b30: 22 52 65 61 73 6f 6e 20 66 6f 72 20 6e 6f 74 20 "Reason for not
1b40: 64 6f 69 6e 67 20 72 65 6d 6f 74 65 20 74 65 73 doing remote tes
1b50: 74 73 3a 20 24 6e 6f 52 65 6d 6f 74 65 54 65 73 ts: $noRemoteTes
1b60: 74 52 65 61 73 6f 6e 22 0a 20 20 20 20 7d 0a 7d tReason". }.}
1b70: 0a 0a 23 0a 23 20 49 66 20 77 65 20 64 6f 20 74 ..#.# If we do t
1b80: 68 65 20 74 65 73 74 73 2c 20 64 65 66 69 6e 65 he tests, define
1b90: 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 73 65 a command to se
1ba0: 6e 64 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 nd a command to
1bb0: 74 68 65 0a 23 20 72 65 6d 6f 74 65 20 73 65 72 the.# remote ser
1bc0: 76 65 72 2e 0a 23 0a 0a 69 66 20 7b 24 64 6f 54 ver..#..if {$doT
1bd0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1be0: 72 76 65 72 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 rver == 1} {.
1bf0: 20 70 72 6f 63 20 73 65 6e 64 43 6f 6d 6d 61 6e proc sendComman
1c00: 64 20 7b 63 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 d {c} {..global
1c10: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 0a 09 commandSocket...
1c20: 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e if {[eof $comman
1c30: 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 20 20 20 dSocket]} {..
1c40: 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 error "remote s
1c50: 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 65 erver disappeare
1c60: 64 22 0a 09 7d 0a 0a 09 69 66 20 7b 5b 63 61 74 d"..}...if {[cat
1c70: 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e ch {puts $comman
1c80: 64 53 6f 63 6b 65 74 20 24 63 7d 20 6d 73 67 5d dSocket $c} msg]
1c90: 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 } {.. error "
1ca0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 remote server di
1cb0: 73 61 70 70 61 65 72 65 64 3a 20 24 6d 73 67 22 sappaered: $msg"
1cc0: 0a 09 7d 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 ..}..if {[catch
1cd0: 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f {puts $commandSo
1ce0: 63 6b 65 74 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d cket "--Marker--
1cf0: 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d Marker--Marker--
1d00: 22 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 "} msg]} {..
1d10: 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 error "remote se
1d20: 72 76 65 72 20 64 69 73 61 70 70 65 61 72 65 64 rver disappeared
1d30: 3a 20 24 6d 73 67 22 0a 09 7d 0a 0a 09 73 65 74 : $msg"..}...set
1d40: 20 72 65 73 70 20 22 22 0a 09 77 68 69 6c 65 20 resp ""..while
1d50: 7b 31 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {1} {.. set l
1d60: 69 6e 65 20 5b 67 65 74 73 20 24 63 6f 6d 6d 61 ine [gets $comma
1d70: 6e 64 53 6f 63 6b 65 74 5d 0a 09 20 20 20 20 69 ndSocket].. i
1d80: 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 f {[eof $command
1d90: 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 09 65 72 72 Socket]} {...err
1da0: 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 or "remote serve
1db0: 72 20 64 69 73 61 70 70 65 61 72 65 64 22 0a 09 r disappeared"..
1dc0: 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b 5b }.. if {[
1dd0: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 24 string compare $
1de0: 6c 69 6e 65 20 22 2d 2d 4d 61 72 6b 65 72 2d 2d line "--Marker--
1df0: 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d Marker--Marker--
1e00: 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 69 66 20 "] == 0} {...if
1e10: 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 {[string compare
1e20: 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 30 [lindex $resp 0
1e30: 5d 20 65 72 72 6f 72 5d 20 3d 3d 20 30 7d 20 7b ] error] == 0} {
1e40: 0a 09 09 20 20 20 20 65 72 72 6f 72 20 5b 6c 69 ... error [li
1e50: 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 ndex $resp 1]...
1e60: 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 72 } else {... r
1e70: 65 74 75 72 6e 20 5b 6c 69 6e 64 65 78 20 24 72 eturn [lindex $r
1e80: 65 73 70 20 31 5d 0a 09 09 7d 0a 09 20 20 20 20 esp 1]...}..
1e90: 7d 20 65 6c 73 65 20 7b 0a 09 09 61 70 70 65 6e } else {...appen
1ea0: 64 20 72 65 73 70 20 24 6c 69 6e 65 20 22 5c 6e d resp $line "\n
1eb0: 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 ".. }..}.
1ec0: 7d 0a 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }.. sendComma
1ed0: 6e 64 20 5b 6c 69 73 74 20 70 72 6f 63 20 64 70 nd [list proc dp
1ee0: 75 74 73 20 5b 69 6e 66 6f 20 61 72 67 73 20 64 uts [info args d
1ef0: 70 75 74 73 5d 20 5b 69 6e 66 6f 20 62 6f 64 79 puts] [info body
1f00: 20 64 70 75 74 73 5d 5d 0a 0a 20 20 20 20 70 72 dputs]].. pr
1f10: 6f 63 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 oc sendCertValue
1f20: 73 20 7b 7d 20 7b 0a 09 23 20 57 65 20 6e 65 65 s {} {..# We nee
1f30: 64 20 74 6f 20 62 65 20 61 62 6c 65 20 74 6f 20 d to be able to
1f40: 73 65 6e 64 20 63 65 72 74 69 66 69 63 61 74 65 send certificate
1f50: 20 76 61 6c 75 65 73 20 74 68 61 74 20 6e 6f 72 values that nor
1f60: 6d 61 6c 69 7a 65 0a 09 23 20 66 69 6c 65 6e 61 malize..# filena
1f70: 6d 65 73 20 61 63 72 6f 73 73 20 70 6c 61 74 66 mes across platf
1f80: 6f 72 6d 73 0a 09 73 65 6e 64 43 6f 6d 6d 61 6e orms..sendComman
1f90: 64 20 7b 0a 09 20 20 20 20 73 65 74 20 63 65 72 d {.. set cer
1fa0: 74 73 44 69 72 09 5b 66 69 6c 65 20 6a 6f 69 6e tsDir.[file join
1fb0: 20 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 5b [file dirname [
1fc0: 69 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 63 65 info script]] ce
1fd0: 72 74 73 5d 0a 09 20 20 20 20 73 65 74 20 73 65 rts].. set se
1fe0: 72 76 65 72 43 65 72 74 09 5b 66 69 6c 65 20 6a rverCert.[file j
1ff0: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 65 oin $certsDir se
2000: 72 76 65 72 2e 70 65 6d 5d 0a 09 20 20 20 20 73 rver.pem].. s
2010: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 09 5b 66 et clientCert.[f
2020: 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 ile join $certsD
2030: 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 09 ir client.pem]..
2040: 20 20 20 20 73 65 74 20 63 61 43 65 72 74 09 09 set caCert..
2050: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
2060: 73 44 69 72 20 63 61 63 65 72 74 2e 70 65 6d 5d sDir cacert.pem]
2070: 0a 09 20 20 20 20 73 65 74 20 73 65 72 76 65 72 .. set server
2080: 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 Key.[file join $
2090: 63 65 72 74 73 44 69 72 20 73 6b 65 79 2e 70 65 certsDir skey.pe
20a0: 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 6c 69 65 m].. set clie
20b0: 6e 74 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e ntKey.[file join
20c0: 20 24 63 65 72 74 73 44 69 72 20 63 6b 65 79 2e $certsDir ckey.
20d0: 70 65 6d 5d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a pem]..}. }.}.
20e0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 .test tlsIO-1.1
20f0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2100: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2110: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2120: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2130: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2140: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2150: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2160: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2170: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 socket -server c
2180: 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f ommand ?options?
2190: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
21a0: 6c 73 49 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 lsIO-1.2 {arg pa
21b0: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
21c0: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
21d0: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
21e0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
21f0: 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d t -server foo} m
2200: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2210: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2220: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2230: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
2240: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
2250: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2260: 4f 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 O-1.3 {arg parsi
2270: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2280: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
2290: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
22a0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
22b0: 6d 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 myaddr} msg] $ms
22c0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
22d0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
22e0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
22f0: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
2300: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
2310: 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.4 {arg parsing
2320: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2330: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2340: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2350: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
2360: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 addr 127.0.0.1}
2370: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
2380: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
2390: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
23a0: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
23b0: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
23c0: 74 20 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 t tlsIO-1.5 {arg
23d0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
23e0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
23f0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2400: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2410: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 cket -myport} ms
2420: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2430: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2440: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2450: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2460: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
2470: 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 72 67 20 70 tlsIO-1.6 {arg p
2480: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2490: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
24a0: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
24b0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
24c0: 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d et -myport xxxx}
24d0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
24e0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
24f0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
2500: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
2510: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
2520: 73 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 72 st tlsIO-1.7 {ar
2530: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2540: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2550: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2560: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2570: 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 ocket -myport 25
2580: 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 22} msg] $msg.}
2590: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
25a0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
25b0: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
25c0: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
25d0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 38 20 .test tlsIO-1.8
25e0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
25f0: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2600: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2610: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2620: 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a ::socket -froboz
2630: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2640: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2650: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2660: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
2670: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2680: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 39 20 7b 61 est tlsIO-1.9 {a
2690: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
26a0: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
26b0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
26c0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
26d0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 66 socket -server f
26e0: 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 35 32 31 20 oo -myport 2521
26f0: 33 33 33 33 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 3333} msg] $msg.
2700: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2710: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2720: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2730: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 er command ?opti
2740: 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 ons? port"}}..te
2750: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 st tlsIO-1.10 {a
2760: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2770: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2780: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2790: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
27a0: 73 6f 63 6b 65 74 20 68 6f 73 74 20 32 35 32 38 socket host 2528
27b0: 20 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 -junk} msg] $ms
27c0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
27d0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
27e0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
27f0: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
2800: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
2810: 31 2e 31 31 20 7b 61 72 67 20 70 61 72 73 69 6e 1.11 {arg parsin
2820: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
2830: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
2840: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
2850: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
2860: 65 72 76 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 erver callback 2
2870: 35 32 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 520 --} msg] $ms
2880: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
2890: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
28a0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
28b0: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
28c0: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
28d0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 test tlsIO-1.12
28e0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
28f0: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2900: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2910: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2920: 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 ::socket foo bad
2930: 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a port} msg] $msg.
2940: 7d 20 7b 31 20 7b 65 78 70 65 63 74 65 64 20 69 } {1 {expected i
2950: 6e 74 65 67 65 72 20 62 75 74 20 67 6f 74 20 22 nteger but got "
2960: 62 61 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 badport"}}..test
2970: 20 74 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 70 20 tlsIO-2.1 {tcp
2980: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
2990: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
29a0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
29b0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
29c0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
29d0: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
29e0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
29f0: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
2a00: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
2a10: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
2a20: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
2a30: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
2a40: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
2a50: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
2a60: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
2a70: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
2a80: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
2a90: 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 28 \]". puts
2aa0: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
2ab0: 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 t {file addr por
2ac0: 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c t} {.. global
2ad0: 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f x.. set x do
2ae0: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 ne. c
2af0: 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 lose $file..}..p
2b00: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
2b10: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
2b20: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
2b30: 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d f..puts $x. }
2b40: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
2b50: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
2b60: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
2b70: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
2b80: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
2b90: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
2ba0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2bb0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
2bc0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
2bd0: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
2be0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
2bf0: 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 .0.0.1 8828} msg
2c00: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
2c10: 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c x $msg. } el
2c20: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 se {. lap
2c30: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
2c40: 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 . close $
2c50: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 msg. }. la
2c60: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
2c70: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
2c80: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
2c90: 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b y done {}}..if [
2ca0: 69 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 info exists port
2cb0: 5d 20 7b 0a 20 20 20 20 69 6e 63 72 20 70 6f 72 ] {. incr por
2cc0: 74 0a 7d 20 65 6c 73 65 20 7b 20 0a 20 20 20 20 t.} else { .
2cd0: 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 24 set port [expr $
2ce0: 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 2b 20 tlsServerPort +
2cf0: 5b 70 69 64 5d 25 31 30 32 34 5d 0a 7d 0a 0a 74 [pid]%1024].}..t
2d00: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 32 20 7b 74 est tlsIO-2.2 {t
2d10: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 cp connection wi
2d20: 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 74 20 73 th client port s
2d30: 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 pecified} {socke
2d40: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
2d50: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
2d60: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
2d70: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
2d80: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
2d90: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
2da0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
2db0: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
2dc0: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
2dd0: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
2de0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2df0: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
2e00: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
2e10: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
2e20: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
2e30: 65 79 20 38 38 32 39 20 5c 5d 22 0a 20 20 20 20 ey 8829 \]".
2e40: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
2e50: 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 accept {sock add
2e60: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 r port} {.
2e70: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
2e80: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
2e90: 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 70 "[gets $sock] $p
2ea0: 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 ort".
2eb0: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
2ec0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
2ed0: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
2ee0: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
2ef0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
2f00: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
2f10: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
2f20: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
2f30: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
2f40: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
2f50: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
2f60: 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 f x. global p
2f70: 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 ort. if {[cat
2f80: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2f90: 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a -myport $port \.
2fa0: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
2fb0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
2fc0: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
2fd0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
2fe0: 37 2e 30 2e 30 2e 31 20 38 38 32 39 7d 20 73 6f 7.0.0.1 8829} so
2ff0: 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 ck]} {. s
3000: 65 74 20 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 et x $sock..catc
3010: 68 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 h {close [tls::s
3020: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
3030: 38 38 32 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 8829]}. } els
3040: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
3050: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c $sock hello..fl
3060: 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ush $sock.
3070: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
3080: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
3090: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
30a0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
30b0: 20 73 65 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 set x.} [list r
30c0: 65 61 64 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 eady "hello $por
30d0: 74 22 5d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d t"]..test tlsIO-
30e0: 32 2e 33 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.3 {tcp connect
30f0: 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 ion with client
3100: 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 66 interface specif
3110: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ied} {socket std
3120: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
3130: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
3140: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
3150: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
3160: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
3170: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
3180: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
3190: 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 "set x done"].
31a0: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
31b0: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
31c0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
31d0: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
31e0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
31f0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
3200: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
3210: 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 30 \]". puts
3220: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
3230: 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 t {sock addr por
3240: 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 t} {.
3250: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
3260: 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 puts "[get
3270: 73 20 24 73 6f 63 6b 5d 20 24 61 64 64 72 22 0a s $sock] $addr".
3280: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
3290: 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 e $sock.
32a0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
32b0: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
32c0: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
32d0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
32e0: 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 se $f. }.
32f0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3300: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
3310: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
3320: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
3330: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
3340: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
3350: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 ls::socket -myad
3360: 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 5c 0a 09 dr 127.0.0.1 \..
3370: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
3380: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
3390: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
33a0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
33b0: 2e 30 2e 30 2e 31 20 38 38 33 30 7d 20 73 6f 63 .0.0.1 8830} soc
33c0: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 k]} {. se
33d0: 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 t x $sock. }
33e0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 else {. p
33f0: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a uts $sock hello.
3400: 09 63 61 74 63 68 20 7b 66 6c 75 73 68 20 24 73 .catch {flush $s
3410: 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 6c 61 70 ock}. lap
3420: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
3430: 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 . close $
3440: 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 sock. }. c
3450: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
3460: 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 6c 6c x.} {ready {hell
3470: 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 o 127.0.0.1}}..t
3480: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 34 20 7b 74 est tlsIO-2.4 {t
3490: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 cp connection wi
34a0: 74 68 20 73 65 72 76 65 72 20 69 6e 74 65 72 66 th server interf
34b0: 61 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 7b ace specified} {
34c0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
34d0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
34e0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
34f0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
3500: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3510: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
3520: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
3530: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
3540: 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 done"]. }.
3550: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
3560: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
3570: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
3580: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
3590: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
35a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
35b0: 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 rverKey -myaddr
35c0: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
35d0: 38 38 33 31 20 5c 5d 22 0a 20 20 20 20 70 75 74 8831 \]". put
35e0: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
35f0: 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 ept {sock addr p
3600: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
3610: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
3620: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
3630: 65 74 73 20 24 73 6f 63 6b 5d 22 0a 20 20 20 20 ets $sock]".
3640: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3650: 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 ock.
3660: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
3670: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3680: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3690: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
36a0: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
36b0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
36c0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
36d0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
36e0: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
36f0: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
3700: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
3710: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
3720: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
3730: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
3740: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3750: 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 Key [info hostna
3760: 6d 65 5d 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d me] 8831} sock]}
3770: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
3780: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 $sock. } els
3790: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
37a0: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c $sock hello..fl
37b0: 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ush $sock.
37c0: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
37d0: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
37e0: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
37f0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3800: 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 set x.} {ready
3810: 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 hello}..test tls
3820: 49 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e IO-2.5 {tcp conn
3830: 65 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 ection with redu
3840: 6e 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 ndant server por
3850: 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f t} {socket stdio
3860: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
3870: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
3880: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3890: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
38a0: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
38b0: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
38c0: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
38d0: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
38e0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
38f0: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3900: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3910: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
3920: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
3930: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
3940: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 32 $serverKey 8832
3950: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
3960: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
3970: 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d {sock addr port}
3980: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 {. g
3990: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
39a0: 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 puts "[gets
39b0: 24 73 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 $sock]".
39c0: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
39d0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
39e0: 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 x done..}..puts
39f0: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
3a00: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
3a10: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 mer..close $f.
3a20: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
3a30: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
3a40: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
3a50: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
3a60: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
3a70: 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b s $f x. if {[
3a80: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
3a90: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
3aa0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
3ab0: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
3ac0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
3ad0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 32 7d 20 127.0.0.1 8832}
3ae0: 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 sock]} {.
3af0: 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 set x $sock.
3b00: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
3b10: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
3b20: 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a lo..flush $sock.
3b30: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
3b40: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
3b50: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
3b60: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
3b70: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
3b80: 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 ready hello}.tes
3b90: 74 20 74 6c 73 49 4f 2d 32 2e 36 20 7b 74 63 70 t tlsIO-2.6 {tcp
3ba0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f connection} {so
3bb0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
3bc0: 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 status ok. if
3bd0: 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 {![catch {set s
3be0: 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ock [tls::socket
3bf0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 33 5d 127.0.0.1 8833]
3c00: 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 }]} {..if {![cat
3c10: 63 68 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d ch {gets $sock}]
3c20: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 } {.. set sta
3c30: 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 tus broken..}..c
3c40: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
3c50: 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a . set status.
3c60: 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f } ok..test tlsIO
3c70: 2d 32 2e 37 20 7b 65 63 68 6f 20 73 65 72 76 65 -2.7 {echo serve
3c80: 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f r, one line} {so
3c90: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
3ca0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
3cb0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
3cc0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
3cd0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
3ce0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
3cf0: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
3d00: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 er 2000 "set x d
3d10: 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 one"]. }.
3d20: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
3d30: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
3d40: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
3d50: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
3d60: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3d70: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
3d80: 65 72 4b 65 79 20 38 38 33 34 20 5c 5d 22 0a 20 erKey 8834 \]".
3d90: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
3da0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
3db0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
3dc0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
3dd0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
3de0: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
3df0: 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 gure $s -transla
3e00: 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 tion lf -bufferi
3e10: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 ng line.
3e20: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
3e30: 20 7b 0a 09 20 20 20 20 20 73 65 74 20 6c 20 5b {.. set l [
3e40: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 gets $s].
3e50: 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 if {[eof $
3e60: 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 s]} {.
3e70: 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a global x.
3e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e90: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 close $s.
3ea0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
3eb0: 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 done.
3ec0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
3ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 put
3ee0: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
3ef0: 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 }..}..puts
3f00: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
3f10: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
3f20: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 mer..close $f..p
3f30: 75 74 73 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 uts done. }.
3f40: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3f50: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
3f60: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
3f70: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
3f80: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
3f90: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
3fa0: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
3fb0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
3fc0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
3fd0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3fe0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
3ff0: 33 34 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 34]. fconfigu
4000: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
4010: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
4020: 6f 6e 20 6c 66 0a 20 20 20 20 70 75 74 73 20 24 on lf. puts $
4030: 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 s "hello abcdefg
4040: 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 hijklmnop". a
4050: 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 fter 1000. se
4060: 74 20 78 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t x [gets $s].
4070: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
4080: 65 74 20 79 20 5b 67 65 74 73 20 24 66 5d 0a 20 et y [gets $f].
4090: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
40a0: 6c 69 73 74 20 24 78 20 24 79 0a 7d 20 7b 7b 68 list $x $y.} {{h
40b0: 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b ello abcdefghijk
40c0: 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 65 lmnop} done}..te
40d0: 73 74 20 74 6c 73 49 4f 2d 32 2e 38 20 7b 65 63 st tlsIO-2.8 {ec
40e0: 68 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f 70 20 ho server, loop
40f0: 35 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 6c 65 50 times, single
4100: 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f connection} {so
4110: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
4120: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
4130: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
4140: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
4150: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
4160: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
4170: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
4180: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4190: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
41a0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
41b0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
41c0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
41d0: 38 33 35 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 835 \]". puts
41e0: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
41f0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 pt {s a p} {.
4200: 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 fileeve
4210: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
4220: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 list echo $s].
4230: 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 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 0a 20 20 20 20 20 20 20 20 ng line.
4260: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
4270: 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 {.. global
4280: 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 i. s
4290: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 et l [gets $s].
42a0: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b if {
42b0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 [eof $s]} {.
42c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f glo
42d0: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
42e0: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a close $s.
42f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4300: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
4310: 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 } else
4320: 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 { .. inc
4330: 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 r i.
4340: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a puts $s $l.
4350: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 }..
4360: 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 75 74 73 }..set i 0..puts
4370: 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 ready..set time
4380: 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 r [after 20000 "
4390: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 76 77 set x done"]..vw
43a0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
43b0: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
43c0: 65 20 24 66 0a 09 70 75 74 73 20 22 64 6f 6e 65 e $f..puts "done
43d0: 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 20 20 63 $i". }. c
43e0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
43f0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
4400: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
4410: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
4420: 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 gets $f.
4430: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
4440: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
4450: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
4460: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
4470: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
4480: 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 35 5d 0a 127.0.0.1 8835].
4490: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
44a0: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
44b0: 65 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 66 e. catch {..f
44c0: 6f 72 20 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 or {set x 0} {$x
44d0: 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 < 50} {incr x}
44e0: 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 22 {.. puts $s "
44f0: 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a hello abcdefghij
4500: 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 klmnop".. get
4510: 73 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 s $s..}. }.
4520: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
4530: 61 74 63 68 20 7b 73 65 74 20 78 20 5b 67 65 74 atch {set x [get
4540: 73 20 24 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 s $f]}. close
4550: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
4560: 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 {done 50}..test
4570: 74 6c 73 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 tlsIO-2.9 {socke
4580: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 t conflict} {soc
4590: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
45a0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
45b0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
45c0: 70 74 20 38 38 32 38 5d 0a 20 20 20 20 72 65 6d pt 8828]. rem
45d0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
45e0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
45f0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
4600: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 s -nonewline $f
4610: 7b 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 {package require
4620: 20 74 6c 73 3b 20 74 6c 73 3a 3a 73 6f 63 6b 65 tls; tls::socke
4630: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
4640: 20 38 38 32 38 7d 0a 20 20 20 20 63 6c 6f 73 65 8828}. close
4650: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
4660: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
4670: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
4680: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
4690: 67 65 74 73 20 24 66 0a 20 20 20 20 61 66 74 65 gets $f. afte
46a0: 72 20 31 30 30 0a 20 20 20 20 73 65 74 20 78 20 r 100. set x
46b0: 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 63 6c [list [catch {cl
46c0: 6f 73 65 20 24 66 7d 20 6d 73 67 5d 20 5b 73 74 ose $f} msg] [st
46d0: 72 69 6e 67 20 72 61 6e 67 65 20 24 6d 73 67 20 ring range $msg
46e0: 30 20 34 33 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 0 43]]. close
46f0: 20 24 73 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $s. set x.}
4700: 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 {1 {couldn't ope
4710: 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 n socket: addres
4720: 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 s already in use
4730: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 }}..test tlsIO-2
4740: 2e 31 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 .10 {close on ac
4750: 63 65 70 74 2c 20 61 63 63 65 70 74 65 64 20 73 cept, accepted s
4760: 6f 63 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73 6f ocket lives} {so
4770: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
4780: 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 done 0. set t
4790: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
47a0: 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 0 "set done time
47b0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 d_out"]. set
47c0: 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ss [tls::socket
47d0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
47e0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
47f0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
4800: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
4810: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 30 $serverKey 8830
4820: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
4830: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
4840: 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24 73 bal ss..close $s
4850: 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 s..fileevent $s
4860: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 readable "readit
4870: 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 72 65 $s"..fconfigure
4880: 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20 20 $s -trans lf.
4890: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 }. proc rea
48a0: 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 dit {s} {..globa
48b0: 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 73 0a l done..gets $s.
48c0: 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 64 .close $s..set d
48d0: 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 one 1. }.
48e0: 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 set cs [tls::soc
48f0: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
4900: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
4910: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
4920: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
4930: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
4940: 20 38 38 33 30 5d 0a 20 20 20 20 63 6c 6f 73 65 8830]. close
4950: 20 24 63 73 0a 0a 20 20 20 20 76 77 61 69 74 20 $cs.. vwait
4960: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
4970: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
4980: 20 73 65 74 20 64 6f 6e 65 0a 7d 20 31 0a 0a 74 set done.} 1..t
4990: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 31 20 7b est tlsIO-2.11 {
49a0: 64 65 74 65 63 74 69 6e 67 20 6e 65 77 20 64 61 detecting new da
49b0: 74 61 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ta} {socket} {.
49c0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
49d0: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
49e0: 20 73 6f 63 6b 0a 09 23 20 77 68 65 6e 20 64 6f sock..# when do
49f0: 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 ing an in-proces
4a00: 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 s client/server
4a10: 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 test, both sides
4a20: 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 65 20 6e need..# to be n
4a30: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 on-blocking for
4a40: 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b the TLS handshak
4a50: 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 e. Also make su
4a60: 72 65 0a 09 23 20 74 6f 20 72 65 74 75 72 6e 20 re..# to return
4a70: 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c the channel to l
4a80: 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f ine buffering mo
4a90: 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 de...fconfigure
4aa0: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $s -blocking 0 -
4ab0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
4ac0: 73 65 74 20 73 6f 63 6b 20 24 73 0a 09 66 69 6c set sock $s..fil
4ad0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
4ae0: 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 le [list do_hand
4af0: 73 68 61 6b 65 20 24 73 5d 0a 20 20 20 20 7d 0a shake $s]. }.
4b00: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
4b10: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4b20: 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 accept \.. -c
4b30: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
4b40: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4b50: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
4b60: 72 76 65 72 4b 65 79 20 38 34 30 30 5d 0a 20 20 rverKey 8400].
4b70: 20 20 73 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 set sock "".
4b80: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
4b90: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
4ba0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
4bb0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
4bc0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
4bd0: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 34 30 ey 127.0.0.1 840
4be0: 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 64 6f 0]. # when do
4bf0: 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 ing an in-proces
4c00: 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 s client/server
4c10: 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 test, both sides
4c20: 20 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 62 need. # to b
4c30: 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 e non-blocking f
4c40: 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 or the TLS hands
4c50: 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b 65 20 hake Also make
4c60: 73 75 72 65 20 74 6f 0a 20 20 20 20 23 20 72 65 sure to. # re
4c70: 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c turn the channel
4c80: 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 to line bufferi
4c90: 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 65 74 ng mode (TLS set
4ca0: 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 29 2e s it to 'none').
4cb0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4cc0: 24 73 32 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s2 -blocking 0
4cd0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4ce0: 20 20 20 20 76 77 61 69 74 20 73 6f 63 6b 0a 20 vwait sock.
4cf0: 20 20 20 70 75 74 73 20 24 73 32 20 6f 6e 65 0a puts $s2 one.
4d00: 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 flush $s2.
4d10: 20 20 23 20 6e 65 65 64 20 75 70 64 61 74 65 20 # need update
4d20: 74 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 to complete TLS
4d30: 68 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f handshake in-pro
4d40: 63 65 73 73 0a 20 20 20 20 75 70 64 61 74 65 0a cess. update.
4d50: 20 20 20 20 61 66 74 65 72 20 35 30 30 0a 20 20 after 500.
4d60: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
4d70: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 ck -blocking 0.
4d80: 20 20 20 73 65 74 20 72 65 73 75 6c 74 20 61 3a set result a:
4d90: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
4da0: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
4db0: 62 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 b:[gets $sock].
4dc0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
4dd0: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a ock -blocking 1.
4de0: 20 20 20 20 70 75 74 73 20 24 73 32 20 74 77 6f puts $s2 two
4df0: 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 . flush $s2.
4e00: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
4e10: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a ock -blocking 0.
4e20: 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 lappend resu
4e30: 6c 74 20 63 3a 5b 67 65 74 73 20 24 73 6f 63 6b lt c:[gets $sock
4e40: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4e50: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
4e60: 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 1. close $s2
4e70: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
4e80: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
4e90: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 7b set result.} {
4ea0: 61 3a 6f 6e 65 20 62 3a 20 63 3a 74 77 6f 7d 0a a:one b: c:two}.
4eb0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 32 .test tlsIO-2.12
4ec0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
4ed0: 3b 20 6e 6f 20 63 65 72 74 69 66 69 63 61 74 65 ; no certificate
4ee0: 73 20 73 70 65 63 69 66 69 65 64 7d 20 5c 0a 09 s specified} \..
4ef0: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 75 6e {socket stdio un
4f00: 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 20 23 20 ixOnly} {. #
4f10: 54 68 65 72 65 20 69 73 20 61 20 64 65 62 75 67 There is a debug
4f20: 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 57 69 assertion on Wi
4f30: 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 20 63 ndows/SSL that c
4f40: 61 75 73 65 73 20 61 20 63 72 61 73 68 20 77 68 auses a crash wh
4f50: 65 6e 20 74 68 65 0a 20 20 20 20 23 20 63 65 72 en the. # cer
4f60: 74 69 66 69 63 61 74 65 20 69 73 6e 27 74 20 73 tificate isn't s
4f70: 70 65 63 69 66 69 65 64 2e 0a 20 20 20 20 72 65 pecified.. re
4f80: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
4f90: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
4fa0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
4fb0: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
4fc0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
4fd0: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
4fe0: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 74 er 2000 "set x t
4ff0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 imed_out"]..set
5000: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
5010: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
5020: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
5030: 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 {file addr port
5040: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
5050: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
5060: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c e. cl
5070: 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 ose $file..}..pu
5080: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
5090: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
50a0: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
50b0: 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a ..puts $x. }.
50c0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
50d0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
50e0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
50f0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5100: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
5110: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
5120: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 h {tls::socket 1
5130: 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 27.0.0.1 8828} m
5140: 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 sg]} {. s
5150: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
5160: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c else {. l
5170: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
5180: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
5190: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
51a0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
51b0: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
51c0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
51d0: 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 ady done {}}..te
51e0: 73 74 20 74 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f st tlsIO-3.1 {so
51f0: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b cket conflict} {
5200: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
5210: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
5220: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
5230: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
5240: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
5250: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
5260: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
5270: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
5280: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
5290: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
52a0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
52b0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
52c0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
52d0: 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a verKey 8828 \]".
52e0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
52f0: 75 74 73 20 72 65 61 64 79 0a 09 67 65 74 73 20 uts ready..gets
5300: 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a stdin..close $f.
5310: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
5320: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
5330: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
5340: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
5350: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
5360: 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 gets $f. set
5370: 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b x [list [catch {
5380: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
5390: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
53a0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
53b0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
53c0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
53d0: 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 .-server acce
53e0: 70 74 20 38 38 32 38 7d 20 6d 73 67 5d 20 5c 0a pt 8828} msg] \.
53f0: 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 75 74 73 ..$msg]. puts
5400: 20 24 66 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 $f bye. clos
5410: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
5420: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
5430: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
5440: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
5450: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
5460: 33 2e 32 20 7b 73 65 72 76 65 72 20 77 69 74 68 3.2 {server with
5470: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
5480: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
5490: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
54a0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
54b0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
54c0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
54d0: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
54e0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
54f0: 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 1 [after 30000 "
5500: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5510: 5d 0a 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 ]..set t2 [after
5520: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
5530: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 med_out"]..set t
5540: 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 3 [after 32000 "
5550: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5560: 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 ]..set counter 0
5570: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
5580: 24 66 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a $f "set s \[tls:
5590: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
55a0: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
55b0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
55c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
55d0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
55e0: 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 8828 \]". pu
55f0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
5600: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
5610: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
5620: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
5630: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
5640: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
5650: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 fering line..}..
5660: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
5670: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 . global x.
5680: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
5690: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
56a0: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
56b0: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
56c0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
56d0: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
56e0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
56f0: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
5700: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 se {.
5710: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
5720: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a . }.
5730: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
5740: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
5750: 61 6e 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 ancel $t1..vwait
5760: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
5770: 20 24 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 $t2..vwait x..a
5780: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a fter cancel $t3.
5790: 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 .close $s..puts
57a0: 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $x. }. clo
57b0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
57c0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
57d0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
57e0: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
57f0: 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 set x [gets $
5800: 66 5d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 f]. set s1 [t
5810: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
5820: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
5830: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
5840: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5850: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
5860: 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 127.0.0.1 882
5870: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
5880: 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 e $s1 -buffering
5890: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 line. set s2
58a0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
58b0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
58c0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
58d0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
58e0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
58f0: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
5900: 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8828]. fconfi
5910: 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 gure $s2 -buffer
5920: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
5930: 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s3 [tls::socket
5940: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
5950: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
5960: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
5970: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
5980: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
5990: 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 8828]. fco
59a0: 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 nfigure $s3 -buf
59b0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
59c0: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
59d0: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
59e0: 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 } {..puts $s1 he
59f0: 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 llo,s1..gets $s1
5a00: 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f ..puts $s2 hello
5a10: 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 ,s2..gets $s2..p
5a20: 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 uts $s3 hello,s3
5a30: 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d ..gets $s3. }
5a40: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
5a50: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
5a60: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 6c close $s3. l
5a70: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
5a80: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
5a90: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
5aa0: 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 dy done}..test t
5ab0: 6c 73 49 4f 2d 34 2e 31 20 7b 73 65 72 76 65 72 lsIO-4.1 {server
5ac0: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
5ad0: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
5ae0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 23 20 68 61 tdio} {. # ha
5af0: 76 65 20 73 65 65 6e 20 69 6e 74 65 72 6d 69 74 ve seen intermit
5b00: 74 65 6e 74 20 68 61 6e 67 73 20 6f 6e 20 57 69 tent hangs on Wi
5b10: 6e 64 6f 77 73 0a 20 20 20 20 72 65 6d 6f 76 65 ndows. remove
5b20: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
5b30: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
5b40: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
5b50: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
5b60: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 require tls..ge
5b70: 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 ts stdin. }.
5b80: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
5b90: 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s \[tls::socket
5ba0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
5bb0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
5bc0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5bd0: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
5be0: 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 0.1 8828 \]".
5bf0: 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e puts $f {..fcon
5c00: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
5c10: 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 7b ring line..for {
5c20: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
5c30: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
5c40: 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c puts $s hell
5c50: 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 o.. gets $s..
5c60: 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 }..close $s..put
5c70: 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 69 s bye..gets stdi
5c80: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 n. }. clos
5c90: 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 20 e $f. set p1
5ca0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
5cb0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
5cc0: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
5cd0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 fconfigure $p
5ce0: 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 1 -buffering lin
5cf0: 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f 70 e. set p2 [op
5d00: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
5d10: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
5d20: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
5d30: 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 20 2d fconfigure $p2 -
5d40: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
5d50: 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 6e 20 set p3 [open
5d60: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
5d70: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
5d80: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f pt]" r+]. fco
5d90: 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 75 66 nfigure $p3 -buf
5da0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5db0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
5dc0: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
5dd0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
5de0: 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 line..fileevent
5df0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
5e00: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 7d t echo $s]. }
5e10: 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f 20 7b . proc echo {
5e20: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 20 s} {..global x.
5e30: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
5e40: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 69 ts $s]. i
5e50: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
5e60: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
5e70: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
5e80: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
5e90: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
5ea0: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
5eb0: 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 $l. }.
5ec0: 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 5b 61 }. set t1 [a
5ed0: 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74 20 fter 30000 "set
5ee0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
5ef0: 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 set t2 [after
5f00: 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 31000 "set x tim
5f10: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 ed_out"]. set
5f20: 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 t3 [after 32000
5f30: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
5f40: 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 t"]. set s [t
5f50: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
5f60: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
5f70: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
5f80: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5f90: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
5fa0: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
5fb0: 74 20 38 38 32 38 5d 0a 20 20 20 20 70 75 74 73 t 8828]. puts
5fc0: 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 $p1 open. pu
5fd0: 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 ts $p2 open.
5fe0: 70 75 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 puts $p3 open.
5ff0: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 vwait x. vw
6000: 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 ait x. vwait
6010: 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 x. after canc
6020: 65 6c 20 24 74 31 0a 20 20 20 20 61 66 74 65 72 el $t1. after
6030: 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 cancel $t2.
6040: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 after cancel $t3
6050: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
6060: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
6070: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 append l [list p
6080: 31 20 5b 67 65 74 73 20 24 70 31 5d 20 24 78 5d 1 [gets $p1] $x]
6090: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
60a0: 6c 69 73 74 20 70 32 20 5b 67 65 74 73 20 24 70 list p2 [gets $p
60b0: 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 2] $x]. lappe
60c0: 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 nd l [list p3 [g
60d0: 65 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 ets $p3] $x].
60e0: 20 70 75 74 73 20 24 70 31 20 62 79 65 0a 20 20 puts $p1 bye.
60f0: 20 20 70 75 74 73 20 24 70 32 20 62 79 65 0a 20 puts $p2 bye.
6100: 20 20 20 70 75 74 73 20 24 70 33 20 62 79 65 0a puts $p3 bye.
6110: 20 20 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 close $p1.
6120: 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 close $p2.
6130: 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 73 65 close $p3. se
6140: 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 t l.} {{p1 bye d
6150: 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e one} {p2 bye don
6160: 65 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d e} {p3 bye done}
6170: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e }..test tlsIO-4.
6180: 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 2 {byte order pr
6190: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
61a0: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b umbers, htons} {
61b0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
61c0: 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b t x ok. if {[
61d0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
61e0: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
61f0: 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 0x3000} msg]} {.
6200: 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 .set x $msg.
6210: 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 } else {..close
6220: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
6230: 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 et x.} ok..test
6240: 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 74 65 20 tlsIO-5.1 {byte
6250: 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 order problems,
6260: 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 socket numbers,
6270: 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 htons} \..{socke
6280: 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f t unixOnly notRo
6290: 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 ot} {. set x
62a0: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
62b0: 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 ocket: not owner
62c0: 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 }. if {![catc
62d0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
62e0: 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 7d server dodo 0x1}
62f0: 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 msg]} {.
6300: 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 set x {htons pr
6310: 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 oblem, should be
6320: 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 disallowed, are
6330: 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 you running as
6340: 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 SU?}..close $msg
6350: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
6360: 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 .} {couldn't ope
6370: 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 n socket: not ow
6380: 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d ner}.test tlsIO-
6390: 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.2 {byte order
63a0: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
63b0: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
63c0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
63d0: 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 set x {couldn't
63e0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 open socket: por
63f0: 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 t number too hig
6400: 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 h}. if {![cat
6410: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
6420: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 -server dodo 0x1
6430: 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 0000} msg]} {..s
6440: 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c et x {port resol
6450: 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 ution problem, s
6460: 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f hould be disallo
6470: 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 wed}..close $msg
6480: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
6490: 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 .} {couldn't ope
64a0: 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e n socket: port n
64b0: 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a umber too high}.
64c0: 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 33 20 7b test tlsIO-5.3 {
64d0: 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c byte order probl
64e0: 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 ems, socket numb
64f0: 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b ers, htons} \..{
6500: 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 socket unixOnly
6510: 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 notRoot} {. s
6520: 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f et x {couldn't o
6530: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
6540: 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 owner}. if {!
6550: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
6560: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
6570: 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 21} msg]} {..se
6580: 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c t x {htons probl
6590: 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 em, should be di
65a0: 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f sallowed, are yo
65b0: 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f u running as SU?
65c0: 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 }..close $msg.
65d0: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
65e0: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
65f0: 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 ocket: not owner
6600: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 36 2e }..test tlsIO-6.
6610: 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 1 {accept callba
6620: 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 ck error} {socke
6630: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 23 t stdio} {. #
6640: 20 54 68 65 72 65 20 69 73 20 61 20 64 65 62 75 There is a debu
6650: 67 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 57 g assertion on W
6660: 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 20 indows/SSL that
6670: 63 61 75 73 65 73 20 61 20 63 72 61 73 68 20 77 causes a crash w
6680: 68 65 6e 20 74 68 65 0a 20 20 20 20 23 20 63 65 hen the. # ce
6690: 72 74 69 66 69 63 61 74 65 20 69 73 6e 27 74 20 rtificate isn't
66a0: 73 70 65 63 69 66 69 65 64 2e 0a 20 20 20 20 72 specified.. r
66b0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
66c0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
66d0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
66e0: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
66f0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
6700: 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 s..gets stdin.
6710: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
6720: 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 [list tls::socke
6730: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6740: 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 34 38 t 127.0.0.1 8848
6750: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
6760: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
6770: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
6780: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
6790: 74 5d 22 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 t]" r+]. proc
67a0: 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a bgerror args {.
67b0: 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 .global x..set x
67c0: 20 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 $args. }.
67d0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
67e0: 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 a p} {expr 10 /
67f0: 30 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 0}. set s [tl
6800: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6810: 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 r accept \..
6820: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
6830: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
6840: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
6850: 73 65 72 76 65 72 4b 65 79 20 38 38 34 38 5d 0a serverKey 8848].
6860: 20 20 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c puts $f hell
6870: 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 o. close $f.
6880: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
6890: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
68a0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
68b0: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
68c0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
68d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
68e0: 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 rename bgerror
68f0: 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 {}. set x.}
6900: 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 72 6f {{divide by zero
6910: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 }}..test tlsIO-7
6920: 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .1 {testing sock
6930: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
6940: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ons} {socket std
6950: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
6960: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
6970: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
6980: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
6990: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
69a0: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 uire tls. }.
69b0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
69c0: 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 tls::socket -se
69d0: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 rver accept \..
69e0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
69f0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
6a00: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6a10: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
6a20: 30 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0]. puts $f {
6a30: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 ..proc accept ar
6a40: 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c gs {.. global
6a50: 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f x.. set x do
6a60: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
6a70: 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 y..set timer [af
6a80: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
6a90: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 timed_out"]..vw
6aa0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
6ab0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d cel $timer. }
6ac0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
6ad0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
6ae0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
6af0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
6b00: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
6b10: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
6b20: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
6b30: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
6b40: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
6b50: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
6b60: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
6b70: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 30 5d 127.0.0.1 8820]
6b80: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
6b90: 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e figure $s -peern
6ba0: 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 ame]. close $
6bb0: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 s. close $f.
6bc0: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
6bd0: 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e lappend l [strin
6be0: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
6bf0: 78 20 24 70 20 30 5d 20 31 32 37 2e 30 2e 30 2e x $p 0] 127.0.0.
6c00: 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 1]. lappend l
6c10: 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 [string compare
6c20: 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 38 [lindex $p 2] 8
6c30: 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 820]. lappend
6c40: 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a l [llength $p].
6c50: 7d 20 7b 30 20 30 20 33 7d 0a 0a 74 65 73 74 20 } {0 0 3}..test
6c60: 74 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 73 74 69 tlsIO-7.2 {testi
6c70: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
6c80: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 ic options} {soc
6c90: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
6ca0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
6cb0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
6cc0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
6cd0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
6ce0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
6cf0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
6d00: 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f "tls::socket -
6d10: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
6d20: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
6d30: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
6d40: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
6d50: 72 76 65 72 4b 65 79 20 38 38 32 31 22 0a 20 20 rverKey 8821".
6d60: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
6d70: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
6d80: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
6d90: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
6da0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
6db0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
6dc0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
6dd0: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
6de0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
6df0: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
6e00: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6e10: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
6e20: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
6e30: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
6e40: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
6e50: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6e60: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
6e70: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
6e80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6e90: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
6ea0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
6eb0: 30 2e 30 2e 31 20 38 38 32 31 5d 0a 20 20 20 20 0.0.1 8821].
6ec0: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
6ed0: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
6ee0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
6ef0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6f00: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
6f10: 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 nd l [llength $p
6f20: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
6f30: 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a 20 20 [lindex $p 0].
6f40: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 lappend l [str
6f50: 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 6e 64 65 ing equal [linde
6f60: 78 20 24 70 20 32 5d 20 38 38 32 31 5d 0a 7d 20 x $p 2] 8821].}
6f70: 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a {3 127.0.0.1 0}.
6f80: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 33 20 .test tlsIO-7.3
6f90: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
6fa0: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
6fb0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
6fc0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6fd0: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
6fe0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
6ff0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7000: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
7010: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
7020: 61 63 63 65 70 74 20 38 38 32 32 5d 0a 20 20 20 accept 8822].
7030: 20 73 65 74 20 6c 20 5b 66 63 6f 6e 66 69 67 75 set l [fconfigu
7040: 72 65 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 re $s]. close
7050: 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 $s. update.
7060: 20 20 20 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d 20 llength $l.}
7070: 31 32 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 12..# bug report
7080: 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 #5812 fconfigur
7090: 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e e doesn't return
70a0: 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 value for '-soc
70b0: 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 kname'..test tls
70c0: 49 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 20 IO-7.4 {testing
70d0: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
70e0: 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 options} {socket
70f0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
7100: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
7110: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
7120: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
7130: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
7140: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d rverKey \. .-
7150: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
7160: 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 23]. proc acc
7170: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
7180: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b lobal x..set x [
7190: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
71a0: 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 ockname]..close
71b0: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 $s. }. set
71c0: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
71d0: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
71e0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
71f0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7200: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
7210: 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e .[info hostn
7220: 61 6d 65 5d 20 38 38 32 33 5d 0a 20 20 20 20 73 ame] 8823]. s
7230: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
7240: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
7250: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
7260: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
7270: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
7280: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
7290: 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 ose $s1. set
72a0: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
72b0: 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d l [lindex $x 2]
72c0: 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 [llength $x].}
72d0: 7b 38 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 20 {8823 3}..# bug
72e0: 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f report #5812 fco
72f0: 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 nfigure doesn't
7300: 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 return value for
7310: 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 '-sockname'..te
7320: 73 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 65 st tlsIO-7.5 {te
7330: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
7340: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
7350: 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 63 7d socket unixOrPc}
7360: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
7370: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
7380: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
7390: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
73a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
73b0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
73c0: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
73d0: 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 8829]. proc
73e0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
73f0: 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 ..global x..set
7400: 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 x [fconfigure $s
7410: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f -sockname]..clo
7420: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
7430: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
7440: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
7450: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
7460: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7470: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
7480: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
7490: 30 2e 30 2e 31 20 38 38 32 39 5d 0a 20 20 20 20 0.0.1 8829].
74a0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
74b0: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
74c0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
74d0: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
74e0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
74f0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
7500: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
7510: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
7520: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 d l [lindex $x 0
7530: 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 ] [lindex $x 2]
7540: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
7550: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 20 33 127.0.0.1 8829 3
7560: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 38 2e }..test tlsIO-8.
7570: 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 1 {testing -asyn
7580: 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 c flag on socket
7590: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
75a0: 20 20 23 20 48 4f 42 42 53 3a 20 73 74 69 6c 6c # HOBBS: still
75b0: 20 66 61 69 6c 73 20 70 6f 73 74 2d 72 65 77 72 fails post-rewr
75c0: 69 74 65 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 ite. # NOTE:
75d0: 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 61 This test may fa
75e0: 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 il on some Solar
75f0: 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 0a is 2.4 systems..
7600: 20 20 20 20 23 20 53 65 65 20 6e 6f 74 65 73 20 # See notes
7610: 69 6e 20 54 63 6c 27 73 20 73 6f 63 6b 65 74 2e in Tcl's socket.
7620: 74 65 73 74 2e 0a 20 20 20 20 73 65 74 20 73 20 test.. set s
7630: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
7640: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
7650: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
7660: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7670: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
7680: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
7690: 65 70 74 20 38 38 33 30 5d 0a 20 20 20 20 70 72 ept 8830]. pr
76a0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
76b0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 23 } {..global x..#
76c0: 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 when doing an i
76d0: 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 n-process client
76e0: 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f /server test, bo
76f0: 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 th sides need..#
7700: 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b to be non-block
7710: 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 ing for the TLS
7720: 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f handshake. Also
7730: 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f make sure..# to
7740: 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e return the chan
7750: 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 nel to line buff
7760: 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f ering mode...fco
7770: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
7780: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e king 0 -bufferin
7790: 67 20 6c 69 6e 65 0a 09 70 75 74 73 20 24 73 20 g line..puts $s
77a0: 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 bye..close $s..s
77b0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a et x done. }.
77c0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
77d0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
77e0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
77f0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7800: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
7810: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
7820: 2d 61 73 79 6e 63 20 5b 69 6e 66 6f 20 68 6f 73 -async [info hos
7830: 74 6e 61 6d 65 5d 20 38 38 33 30 5d 0a 20 20 20 tname] 8830].
7840: 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e # when doing an
7850: 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 in-process clie
7860: 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 nt/server test,
7870: 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a both sides need.
7880: 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d # to be non-
7890: 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 blocking for the
78a0: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 20 TLS handshake
78b0: 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 Also make sure t
78c0: 6f 0a 20 20 20 20 23 20 72 65 74 75 72 6e 20 74 o. # return t
78d0: 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 he channel to li
78e0: 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 ne buffering mod
78f0: 65 20 28 54 4c 53 20 73 65 74 73 20 69 74 20 74 e (TLS sets it t
7900: 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 20 20 66 o 'none').. f
7910: 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 configure $s1 -b
7920: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
7930: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 76 77 ring line. vw
7940: 61 69 74 20 78 0a 20 20 20 20 23 20 54 4c 53 20 ait x. # TLS
7950: 68 61 6e 64 73 68 61 6b 69 6e 67 20 6e 65 65 64 handshaking need
7960: 73 20 6f 6e 65 20 62 79 74 65 20 66 72 6f 6d 20 s one byte from
7970: 74 68 65 20 63 6c 69 65 6e 74 2e 2e 2e 0a 20 20 the client....
7980: 20 20 70 75 74 73 20 24 73 31 20 61 0a 20 20 20 puts $s1 a.
7990: 20 23 20 6e 65 65 64 20 75 70 64 61 74 65 20 74 # need update t
79a0: 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 68 o complete TLS h
79b0: 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f 63 andshake in-proc
79c0: 65 73 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 ess. update.
79d0: 20 20 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 set z [gets $
79e0: 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 s1]. close $s
79f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
7a00: 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a set z.} bye..
7a10: 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b test tlsIO-9.1 {
7a20: 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 testing spurious
7a30: 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 events} {socket
7a40: 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 } {. set len
7a50: 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 0. set spurio
7a60: 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e us 0. set don
7a70: 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 e 0. proc rea
7a80: 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 dlittle {s} {..g
7a90: 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 lobal spurious d
7aa0: 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b one len..set l [
7ab0: 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b read $s 1]..if {
7ac0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
7ad0: 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 l] == 0} {..
7ae0: 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b if {![eof $s]} {
7af0: 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 ...incr spurious
7b00: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
7b10: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
7b20: 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d done 1.. }..}
7b30: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 else {.. inc
7b40: 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 r len [string le
7b50: 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 ngth $l]..}.
7b60: 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 }. proc accep
7b70: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f t {s a p} {..fco
7b80: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
7b90: 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e king 0..fileeven
7ba0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
7bb0: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
7bc0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 $s readable rea
7bd0: 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 dlittle \...-buf
7be0: 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 fering none].
7bf0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
7c00: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
7c10: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
7c20: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
7c30: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
7c40: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
7c50: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
7c60: 20 38 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 8831]. set c
7c70: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
7c80: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
7c90: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
7ca0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
7cb0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
7cc0: 0a 09 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 .. [info host
7cd0: 6e 61 6d 65 5d 20 38 38 33 31 5d 0a 20 20 20 20 name] 8831].
7ce0: 23 20 54 68 69 73 20 64 69 66 66 65 72 73 20 66 # This differs f
7cf0: 72 6f 6d 20 73 6f 63 6b 65 74 2d 39 2e 31 20 69 rom socket-9.1 i
7d00: 6e 20 74 68 61 74 20 62 6f 74 68 20 73 69 64 65 n that both side
7d10: 73 20 6e 65 65 64 20 74 6f 20 62 65 0a 20 20 20 s need to be.
7d20: 20 23 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 # non-blocking
7d30: 62 65 63 61 75 73 65 20 6f 66 20 54 4c 53 27 20 because of TLS'
7d40: 72 65 71 75 69 72 65 64 20 68 61 6e 64 73 68 61 required handsha
7d50: 6b 65 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ke. fconfigur
7d60: 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $c -blocking 0
7d70: 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
7d80: 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 line $c 01234567
7d90: 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 8901234567890123
7da0: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
7db0: 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 0123456789. c
7dc0: 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 lose $c. set
7dd0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
7de0: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
7df0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
7e00: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
7e10: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
7e20: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
7e30: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
7e40: 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 $len.} {0 50}..t
7e50: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 est tlsIO-9.2 {t
7e60: 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 esting async wri
7e70: 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 te, fileevents,
7e80: 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 flush on close}
7e90: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
7ea0: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 et firstblock [s
7eb0: 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 tring repeat a 3
7ec0: 31 5d 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 1]. set secon
7ed0: 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 dblock [string r
7ee0: 65 70 65 61 74 20 62 20 36 35 35 33 35 5d 0a 20 epeat b 65535].
7ef0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
7f00: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
7f10: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
7f20: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 g 0..fileevent $
7f30: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
7f40: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 do_handshake $s
7f50: 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 61 62 readable readab
7f60: 6c 65 20 5c 0a 09 09 2d 74 72 61 6e 73 6c 61 74 le \...-translat
7f70: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 ion lf -buffersi
7f80: 7a 65 20 31 36 33 38 34 20 2d 62 75 66 66 65 72 ze 16384 -buffer
7f90: 69 6e 67 20 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a ing line]. }.
7fa0: 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 62 6c proc readabl
7fb0: 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b e {s} {..set l [
7fc0: 67 65 74 73 20 24 73 5d 0a 09 64 70 75 74 73 20 gets $s]..dputs
7fd0: 22 67 6f 74 20 5c 22 5b 73 74 72 69 6e 67 20 72 "got \"[string r
7fe0: 65 70 6c 61 63 65 20 24 6c 20 31 30 20 65 6e 64 eplace $l 10 end
7ff0: 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b -3 ...]\" \...([
8000: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
8010: 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 66 69 6c ]) from $s"..fil
8020: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
8030: 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 le {}..after 100
8040: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 0 respond $s.
8050: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 }. proc resp
8060: 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 ond {s} {..globa
8070: 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 64 70 l firstblock..dp
8080: 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 uts "send \"[str
8090: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 66 69 72 ing replace $fir
80a0: 73 74 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 stblock 10 end-3
80b0: 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 ...]\" \...([st
80c0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 66 69 72 ring length $fir
80d0: 73 74 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 stblock]) down $
80e0: 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c s"..puts -nonewl
80f0: 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f ine $s $firstblo
8100: 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 ck..after 1000 w
8110: 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 ritedata $s.
8120: 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 }. proc write
8130: 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 data {s} {..glob
8140: 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 al secondblock..
8150: 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 dputs "send \"[s
8160: 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 73 tring replace $s
8170: 65 63 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 65 6e econdblock 10 en
8180: 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 d-3 ...]\" \...(
8190: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
81a0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f secondblock]) do
81b0: 77 6e 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f wn $s"..puts -no
81c0: 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f newline $s $seco
81d0: 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 ndblock..close $
81e0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
81f0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
8200: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8210: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
8220: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8230: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8240: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
8250: 63 63 65 70 74 20 38 38 33 32 5d 0a 20 20 20 20 ccept 8832].
8260: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
8270: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
8280: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
8290: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
82a0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
82b0: 4b 65 79 20 5c 0a 09 20 20 20 20 5b 69 6e 66 6f Key \.. [info
82c0: 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 32 5d hostname] 8832]
82d0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
82e0: 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $c -blocking 0 -
82f0: 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 trans lf -buffer
8300: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
8310: 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 count 0. put
8320: 73 20 24 63 20 68 65 6c 6c 6f 0a 20 20 20 20 70 s $c hello. p
8330: 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b roc readit {s} {
8340: 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 ..global count d
8350: 6f 6e 65 0a 09 73 65 74 20 64 61 74 61 20 5b 72 one..set data [r
8360: 65 61 64 20 24 73 5d 0a 09 64 70 75 74 73 20 22 ead $s]..dputs "
8370: 72 65 61 64 20 5c 22 5b 73 74 72 69 6e 67 20 72 read \"[string r
8380: 65 70 6c 61 63 65 20 24 64 61 74 61 20 31 30 20 eplace $data 10
8390: 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 end-3 ...]\" \..
83a0: 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 .([string length
83b0: 20 24 64 61 74 61 5d 29 20 66 72 6f 6d 20 24 73 $data]) from $s
83c0: 22 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 "..incr count [s
83d0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 61 tring length $da
83e0: 74 61 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 ta]..if {[eof $s
83f0: 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 ]} {.. close
8400: 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f 6e 65 $s.. set done
8410: 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 1..}. }.
8420: 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 fileevent $c rea
8430: 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 63 dable "readit $c
8440: 22 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 ". set done 0
8450: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
8460: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
8470: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
8480: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
8490: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
84a0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
84b0: 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 se $s. list $
84c0: 63 6f 75 6e 74 20 24 64 6f 6e 65 0a 7d 20 7b 36 count $done.} {6
84d0: 35 35 36 36 20 31 7d 0a 0a 74 65 73 74 20 74 6c 5566 1}..test tl
84e0: 73 49 4f 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 sIO-9.3 {testing
84f0: 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d EOF stickyness}
8500: 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 {unexplainedFai
8510: 6c 75 72 65 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 lure socket} {.
8520: 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 # HOBBS: neve
8530: 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 63 74 r worked correct
8540: 6c 79 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e ly. proc coun
8550: 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 t_to_eof {s} {..
8560: 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e global count don
8570: 65 20 74 69 6d 65 72 0a 09 73 65 74 20 6c 20 5b e timer..set l [
8580: 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 gets $s]..if {[e
8590: 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 of $s]} {.. i
85a0: 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 20 20 69 ncr count.. i
85b0: 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 7d 20 7b f {$count > 9} {
85c0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
85d0: 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 09 73 65 t done true...se
85e0: 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 69 73 20 t count {eof is
85f0: 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 sticky}...after
8600: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 20 cancel $timer..
8610: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
8620: 20 20 70 72 6f 63 20 74 69 6d 65 72 70 72 6f 63 proc timerproc
8630: 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f {} {..global do
8640: 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 65 74 20 ne count c..set
8650: 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 74 20 63 done true..set c
8660: 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 65 6e 74 ount {timer went
8670: 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 6e 6f 74 off, eof is not
8680: 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 sticky}..close
8690: 24 63 0a 20 20 20 20 7d 09 0a 20 20 20 20 73 65 $c. }.. se
86a0: 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 73 65 t count 0. se
86b0: 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a 20 20 20 t done false.
86c0: 20 70 72 6f 63 20 77 72 69 74 65 5f 74 68 65 6e proc write_then
86d0: 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 75 _close {s} {..pu
86e0: 74 73 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 ts $s bye..close
86f0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s. }. pr
8700: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
8710: 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 } {..fconfigure
8720: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $s -blocking 0 -
8730: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
8740: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 09 translation lf..
8750: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 fileevent $s wri
8760: 74 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 table [list do_h
8770: 61 6e 64 73 68 61 6b 65 20 24 73 20 77 72 69 74 andshake $s writ
8780: 61 62 6c 65 20 77 72 69 74 65 5f 74 68 65 6e 5f able write_then_
8790: 63 6c 6f 73 65 20 5c 0a 09 09 2d 62 75 66 66 65 close \...-buffe
87a0: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
87b0: 6c 61 74 69 6f 6e 20 6c 66 5d 0a 20 20 20 20 7d lation lf]. }
87c0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
87d0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
87e0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
87f0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8800: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
8810: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
8820: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
8830: 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 833]. set c [
8840: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
8850: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
8860: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
8870: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8880: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
8890: 20 20 20 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 [info hostna
88a0: 6d 65 5d 20 38 38 33 33 5d 0a 20 20 20 20 66 63 me] 8833]. fc
88b0: 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f onfigure $c -blo
88c0: 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 cking 0 -bufferi
88d0: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
88e0: 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 tion lf. file
88f0: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
8900: 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 e "count_to_eof
8910: 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c". set time
8920: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 74 69 r [after 2000 ti
8930: 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 merproc]. vwa
8940: 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 it done. clos
8950: 65 20 24 73 0a 20 20 20 20 73 65 74 20 63 6f 75 e $s. set cou
8960: 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 nt.} {eof is sti
8970: 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 cky}..removeFile
8980: 20 73 63 72 69 70 74 0a 0a 74 65 73 74 20 74 6c script..test tl
8990: 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e sIO-10.1 {testin
89a0: 67 20 73 6f 63 6b 65 74 20 61 63 63 65 70 74 20 g socket accept
89b0: 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 callback error h
89c0: 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 andling} {socket
89d0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 6f 74 65 } {. set gote
89e0: 72 72 6f 72 20 30 0a 20 20 20 20 70 72 6f 63 20 rror 0. proc
89f0: 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 67 6c bgerror args {gl
8a00: 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 obal goterror; s
8a10: 65 74 20 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 et goterror 1}.
8a20: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8a30: 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 ocket -cafile $c
8a40: 61 43 65 72 74 20 2d 73 65 72 76 65 72 20 61 63 aCert -server ac
8a50: 63 65 70 74 20 38 38 39 38 5d 0a 20 20 20 20 70 cept 8898]. p
8a60: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
8a70: 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 72 p} {close $s; er
8a80: 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 20 5b ror}. set c [
8a90: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 tls::socket -caf
8aa0: 69 6c 65 20 24 63 61 43 65 72 74 20 31 32 37 2e ile $caCert 127.
8ab0: 30 2e 30 2e 31 20 38 38 39 38 5d 0a 20 20 20 20 0.0.1 8898].
8ac0: 76 77 61 69 74 20 67 6f 74 65 72 72 6f 72 0a 20 vwait goterror.
8ad0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
8ae0: 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 close $c. set
8af0: 20 67 6f 74 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 goterror.} 1..t
8b00: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 20 7b est tlsIO-11.1 {
8b10: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 tcp connection}
8b20: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
8b30: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
8b40: 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 {. sendCertV
8b50: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
8b60: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
8b70: 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 ket9_1_test_serv
8b80: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
8b90: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
8ba0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
8bb0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
8bc0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8bd0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
8be0: 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 4]..proc accept
8bf0: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
8c00: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
8c10: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 64 6f .. puts $s do
8c20: 6e 65 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 ne.. close $s
8c30: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
8c40: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
8c50: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
8c60: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
8c70: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8c80: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
8c90: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
8ca0: 53 65 72 76 65 72 49 50 20 38 38 33 34 5d 0a 20 ServerIP 8834].
8cb0: 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 set r [gets $
8cc0: 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a s]. close $s.
8cd0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8ce0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f {close $socket9_
8cf0: 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 1_test_server}.
8d00: 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e 65 0a set r.} done.
8d10: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 32 .test tlsIO-11.2
8d20: 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 66 69 {client specifi
8d30: 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b 73 6f es its port} {so
8d40: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
8d50: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
8d60: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
8d70: 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 ists port]} {..i
8d80: 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 ncr port. } e
8d90: 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 lse {..set port
8da0: 5b 65 78 70 72 20 24 74 6c 73 53 65 72 76 65 72 [expr $tlsServer
8db0: 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 Port + [pid]%102
8dc0: 34 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 4]. }. sen
8dd0: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
8de0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
8df0: 65 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 et socket9_2_tes
8e00: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
8e10: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
8e20: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
8e30: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
8e40: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8e50: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8e60: 65 79 20 38 38 33 35 5d 0a 09 70 72 6f 63 20 61 ey 8835]..proc a
8e70: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
8e80: 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 . tls::handsh
8e90: 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 ake $s.. puts
8ea0: 20 24 73 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 $s $p.. clos
8eb0: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
8ec0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
8ed0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
8ee0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
8ef0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8f00: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
8f10: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 6d 79 ntKey \.. -my
8f20: 70 6f 72 74 20 24 70 6f 72 74 20 24 72 65 6d 6f port $port $remo
8f30: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 35 5d teServerIP 8835]
8f40: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
8f50: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
8f60: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
8f70: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
8f80: 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 9_2_test_server}
8f90: 0a 20 20 20 20 69 66 20 7b 24 72 20 3d 3d 20 24 . if {$r == $
8fa0: 70 6f 72 74 7d 20 7b 0a 09 73 65 74 20 72 65 73 port} {..set res
8fb0: 75 6c 74 20 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 ult ok. } els
8fc0: 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 e {..set result
8fd0: 62 72 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 20 broken. }.
8fe0: 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 6f 6b set result.} ok
8ff0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
9000: 33 20 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 3 {trying to con
9010: 6e 65 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d nect, no server}
9020: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
9030: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
9040: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 } {. set stat
9050: 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b us ok. if {![
9060: 63 61 74 63 68 20 7b 73 65 74 20 73 20 5b 74 6c catch {set s [tl
9070: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9080: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
9090: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
90a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
90b0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
90c0: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
90d0: 70 20 38 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 p 8836]}]} {..if
90e0: 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 {![catch {gets
90f0: 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 $s}]} {.. set
9100: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
9110: 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 }..close $s.
9120: 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 }. set status
9130: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 .} ok..test tlsI
9140: 4f 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 O-11.4 {remote e
9150: 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b cho, one line} {
9160: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9170: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9180: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
9190: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
91a0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
91b0: 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 et10_6_test_serv
91c0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
91d0: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
91e0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
91f0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9200: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
9210: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
9220: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 8836]..proc acc
9230: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
9240: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
9250: 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 e $s.. fileev
9260: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
9270: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
9280: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
9290: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
92a0: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 e -translation c
92b0: 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 rlf..}..proc ech
92c0: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
92d0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
92e0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
92f0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
9300: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
9310: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
9320: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
9330: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c f [tls::socket \
9340: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9350: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9360: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9370: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
9380: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
9390: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
93a0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d fconfigure $f -
93b0: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
93c0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
93d0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 65 6c . puts $f hel
93e0: 6c 6f 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 lo. set r [ge
93f0: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
9400: 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $f. sendComm
9410: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
9420: 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 et10_6_test_serv
9430: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
9440: 68 65 6c 6c 6f 0a 0a 74 65 73 74 20 74 6c 73 49 hello..test tlsI
9450: 4f 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 65 20 65 O-11.5 {remote e
9460: 63 68 6f 2c 20 35 30 20 6c 69 6e 65 73 7d 20 7b cho, 50 lines} {
9470: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9480: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9490: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
94a0: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
94b0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
94c0: 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 et10_7_test_serv
94d0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
94e0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
94f0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
9500: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9510: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9520: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
9530: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
9540: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
9550: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
9560: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
9570: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
9580: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
9590: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
95a0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
95b0: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
95c0: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
95d0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
95e0: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
95f0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
9600: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
9610: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
9620: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
9630: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
9640: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9650: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9660: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9670: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9680: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9690: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
96a0: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 8836]. fco
96b0: 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e nfigure $f -tran
96c0: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
96d0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
96e0: 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d for {set cnt 0}
96f0: 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e {$cnt < 50} {in
9700: 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 cr cnt} {..puts
9710: 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 $f "hello, $cnt"
9720: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f ..if {[string co
9730: 6d 70 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 mpare [gets $f]
9740: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 "hello, $cnt"] !
9750: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 = 0} {.. brea
9760: 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 k..}. }. c
9770: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 lose $f. send
9780: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
9790: 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f socket10_7_test_
97a0: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
97b0: 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 69 cnt.} 50..# Maci
97c0: 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 ntosh sockets ca
97d0: 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e n have more than
97e0: 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 one server per
97f0: 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c port.if {$tcl_pl
9800: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 atform(platform)
9810: 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d == "macintosh"}
9820: 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c {. set confl
9830: 69 63 74 52 65 73 75 6c 74 20 7b 30 20 38 38 33 ictResult {0 883
9840: 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 6}.} else {.
9850: 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 set conflictResu
9860: 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 lt {1 {couldn't
9870: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 open socket: add
9880: 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 ress already in
9890: 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c use}}.}..test tl
98a0: 73 49 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 74 sIO-11.6 {socket
98b0: 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b conflict} {sock
98c0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
98d0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
98e0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
98f0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9900: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
9910: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9920: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
9930: 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 verKey \.. -s
9940: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
9950: 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 6]. if {[catc
9960: 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a h {set s2 [tls::
9970: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9980: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
9990: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
99a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
99b0: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
99c0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
99d0: 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 36]} msg]} {..se
99e0: 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 31 t result [list 1
99f0: 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 73 $msg]. } els
9a00: 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 e {..set result
9a10: 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 20 [list 0 [lindex
9a20: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 [fconfigure $s2
9a30: 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 -sockname] 2]]..
9a40: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d 0a close $s2. }.
9a50: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
9a60: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 24 set result.} $
9a70: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a 0a conflictResult..
9a80: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 37 20 test tlsIO-11.7
9a90: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
9aa0: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
9ab0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9ac0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9ad0: 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c . sendCertVal
9ae0: 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ues. sendComm
9af0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
9b00: 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 t10_9_test_serve
9b10: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
9b20: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
9b30: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9b40: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9b50: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
9b60: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
9b70: 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 8836]..proc acce
9b80: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
9b90: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
9ba0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
9bb0: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
9bc0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
9bd0: 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 echo $s]..}..pr
9be0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
9bf0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
9c00: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
9c10: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
9c20: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
9c30: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
9c40: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
9c50: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
9c60: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9c70: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9c80: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9c90: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9ca0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9cb0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
9cc0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
9cd0: 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e re $s1 -bufferin
9ce0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
9cf0: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 2 [tls::socket \
9d00: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9d10: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9d20: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9d30: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
9d40: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
9d50: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
9d60: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 fconfigure $s2
9d70: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
9d80: 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a set s3 [tls:
9d90: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
9da0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
9db0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9dc0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
9dd0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
9de0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
9df0: 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8836]. fconfi
9e00: 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 gure $s3 -buffer
9e10: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 ing line. for
9e20: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
9e30: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
9e40: 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f ..puts $s1 hello
9e50: 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 ,s1..gets $s1..p
9e60: 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 uts $s2 hello,s2
9e70: 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 ..gets $s2..puts
9e80: 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 $s3 hello,s3..g
9e90: 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ets $s3. }.
9ea0: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
9eb0: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
9ec0: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
9ed0: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
9ee0: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
9ef0: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
9f00: 69 0a 7d 20 31 30 30 20 20 20 20 0a 0a 74 65 73 i.} 100 ..tes
9f10: 74 20 74 6c 73 49 4f 2d 31 31 2e 38 20 7b 63 6c t tlsIO-11.8 {cl
9f20: 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 ient with severa
9f30: 6c 20 73 65 72 76 65 72 73 7d 20 7b 73 6f 63 6b l servers} {sock
9f40: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9f50: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9f60: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
9f70: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9f80: 20 7b 0a 09 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 {..tls::init -c
9f90: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
9fa0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9fb0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
9fc0: 72 76 65 72 4b 65 79 0a 09 73 65 74 20 73 31 20 rverKey..set s1
9fd0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
9fe0: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
9ff0: 33 22 20 34 30 30 33 5d 0a 09 73 65 74 20 73 32 3" 4003]..set s2
a000: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
a010: 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 erver "accept 40
a020: 30 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 73 04" 4004]..set s
a030: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 3 [tls::socket -
a040: 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 server "accept 4
a050: 30 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 005" 4005]..proc
a060: 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 20 6d 70 handshake {s mp
a070: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f } {.. if {[eo
a080: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
a090: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 $s.. } elsei
a0a0: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
a0b0: 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 handshake $s} re
a0c0: 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d sult]} {...# Som
a0d0: 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 e errors are nor
a0e0: 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 mal... } else
a0f0: 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 if {$result == 1
a100: 7d 20 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 6b } {...# Handshak
a110: 65 20 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c e complete...fil
a120: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
a130: 6c 65 20 22 22 0a 09 09 70 75 74 73 20 24 73 20 le ""...puts $s
a140: 24 6d 70 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 $mp...close $s..
a150: 20 20 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 }..}..proc a
a160: 63 63 65 70 74 20 7b 6d 70 20 73 20 61 20 70 7d ccept {mp s a p}
a170: 20 7b 0a 09 20 20 20 20 23 20 54 68 65 73 65 20 {.. # These
a180: 68 61 76 65 20 74 6f 20 61 63 63 65 70 74 20 6e have to accept n
a190: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2c 20 62 65 63 on-blocking, bec
a1a0: 61 75 73 65 20 74 68 65 20 68 61 6e 64 73 68 61 ause the handsha
a1b0: 6b 69 6e 67 0a 09 20 20 20 20 23 20 6f 72 64 65 king.. # orde
a1c0: 72 20 69 73 6e 27 74 20 64 65 74 65 72 6d 69 6e r isn't determin
a1d0: 69 73 74 69 63 0a 09 20 20 20 20 66 63 6f 6e 66 istic.. fconf
a1e0: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
a1f0: 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 ng 0 -buffering
a200: 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 line.. fileev
a210: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
a220: 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 [list handshake
a230: 24 73 20 24 6d 70 5d 0a 09 7d 0a 20 20 20 20 7d $s $mp]..}. }
a240: 0a 20 20 20 20 74 6c 73 3a 3a 69 6e 69 74 20 2d . tls::init -
a250: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
a260: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
a270: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
a280: 6c 69 65 6e 74 4b 65 79 0a 20 20 20 20 73 65 74 lientKey. set
a290: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
a2a0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
a2b0: 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 20 73 4003]. set s
a2c0: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 2 [tls::socket $
a2d0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 remoteServerIP 4
a2e0: 30 30 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 004]. set s3
a2f0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
a300: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
a310: 35 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 5]. set l "".
a320: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 lappend l [g
a330: 65 74 73 20 24 73 31 5d 20 5b 67 65 74 73 20 24 ets $s1] [gets $
a340: 73 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 s1] [eof $s1] [g
a350: 65 74 73 20 24 73 32 5d 20 5b 67 65 74 73 20 24 ets $s2] [gets $
a360: 73 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a s2] [eof $s2] \.
a370: 09 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 65 74 .[gets $s3] [get
a380: 73 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d s $s3] [eof $s3]
a390: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
a3a0: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
a3b0: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 close $s3. s
a3c0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c endCommand {..cl
a3d0: 6f 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 ose $s1..close $
a3e0: 73 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 s2..close $s3.
a3f0: 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 }. set l.}
a400: 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 34 20 {4003 {} 1 4004
a410: 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a {} 1 4005 {} 1}.
a420: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 39 .test tlsIO-11.9
a430: 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 {accept callbac
a440: 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 k error} {socket
a450: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
a460: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
a470: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
a480: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
a490: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
a4a0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a4b0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
a4c0: 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 Key \.. -serv
a4d0: 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a er accept 8836].
a4e0: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
a4f0: 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 {s a p} {expr 10
a500: 20 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 62 / 0}. proc b
a510: 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 gerror args {..g
a520: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 lobal x..set x $
a530: 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 args. }. s
a540: 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 endCertValues.
a550: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 if {[catch {se
a560: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 ndCommand {..
a570: 20 73 65 74 20 70 65 65 72 6e 61 6d 65 20 5b 66 set peername [f
a580: 63 6f 6e 66 69 67 75 72 65 20 24 63 61 6c 6c 65 configure $calle
a590: 72 53 6f 63 6b 65 74 20 2d 70 65 65 72 6e 61 6d rSocket -peernam
a5a0: 65 5d 0a 09 20 20 20 20 73 65 74 20 73 20 5b 74 e].. set s [t
a5b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 20 ls::socket \...
a5c0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
a5d0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
a5e0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
a5f0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
a600: 09 20 20 20 20 5b 6c 69 6e 64 65 78 20 24 70 65 . [lindex $pe
a610: 65 72 6e 61 6d 65 20 30 5d 20 38 38 33 36 5d 0a ername 0] 8836].
a620: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
a630: 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 . }} msg]} {..
a640: 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 close $s..error
a650: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
a660: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
a670: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
a680: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
a690: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
a6a0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
a6b0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 close $s. re
a6c0: 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a name bgerror {}.
a6d0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 set x.} {{di
a6e0: 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a vide by zero}}..
a6f0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 test tlsIO-11.10
a700: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
a710: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
a720: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
a730: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a740: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
a750: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
a760: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
a770: 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 socket10_12_test
a780: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
a790: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
a7a0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
a7b0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a7c0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
a7d0: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
a7e0: 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f ccept 8836]..pro
a7f0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
a800: 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 {close $s}.
a810: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
a820: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
a830: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
a840: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
a850: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
a860: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
a870: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
a880: 20 38 38 33 36 5d 0a 20 20 20 20 73 65 74 20 70 8836]. set p
a890: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 [fconfigure $s
a8a0: 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 73 -peername]. s
a8b0: 65 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 65 et n [fconfigure
a8c0: 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 $s -sockname].
a8d0: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
a8e0: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 lappend l [linde
a8f0: 78 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 x $p 2] [llength
a900: 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 $p] [llength $p
a910: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
a920: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
a930: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
a940: 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 12_test_server}.
a950: 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 38 38 33 set l.} {883
a960: 36 20 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 6 3 3}..test tls
a970: 49 4f 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 6e IO-11.11 {testin
a980: 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 g spurious event
a990: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
a9a0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a9b0: 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f er} {. # remo
a9c0: 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 6f 66 te equivalent of
a9d0: 20 39 2e 31 0a 20 20 20 20 73 65 6e 64 43 65 72 9.1. sendCer
a9e0: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
a9f0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
aa00: 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 ocket_test_serve
aa10: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
aa20: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
aa30: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
aa40: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
aa50: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
aa60: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 $serverKey 8836
aa70: 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b ]..proc handshak
aa80: 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 69 66 20 e {s} {.. if
aa90: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 {[eof $s]} {...c
aaa0: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 lose $s.. } e
aab0: 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 lseif {[catch {t
aac0: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
aad0: 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 } result]} {...#
aae0: 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 65 Some errors are
aaf0: 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 normal... }
ab00: 65 6c 73 65 69 66 20 7b 24 72 65 73 75 6c 74 20 elseif {$result
ab10: 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 61 6e 64 == 1} {...# Hand
ab20: 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a 09 shake complete..
ab30: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 .fileevent $s wr
ab40: 69 74 61 62 6c 65 20 22 22 0a 09 09 61 66 74 65 itable ""...afte
ab50: 72 20 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 r 100 writesome
ab60: 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 70 72 $s.. }..}..pr
ab70: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
ab80: 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 } {.. fconfig
ab90: 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 ure $s -translat
aba0: 69 6f 6e 20 22 61 75 74 6f 20 6c 66 22 0a 09 20 ion "auto lf"..
abb0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
abc0: 77 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 68 writable [list h
abd0: 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a 09 7d 0a andshake $s]..}.
abe0: 09 70 72 6f 63 20 77 72 69 74 65 73 6f 6d 65 20 .proc writesome
abf0: 7b 73 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 7b {s} {.. for {
ac00: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
ac10: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
ac20: 09 70 75 74 73 20 24 73 20 22 6c 69 6e 65 20 24 .puts $s "line $
ac30: 69 20 66 72 6f 6d 20 72 65 6d 6f 74 65 20 73 65 i from remote se
ac40: 72 76 65 72 22 0a 09 20 20 20 20 7d 0a 09 20 20 rver".. }..
ac50: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
ac60: 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 }. set len
ac70: 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 0. set spurio
ac80: 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e us 0. set don
ac90: 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 e 0. proc rea
aca0: 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 dlittle {s} {..g
acb0: 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 lobal spurious d
acc0: 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b one len..set l [
acd0: 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b read $s 1]..if {
ace0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
acf0: 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 l] == 0} {..
ad00: 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b if {![eof $s]} {
ad10: 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 ...incr spurious
ad20: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
ad30: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
ad40: 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d done 1.. }..}
ad50: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 else {.. inc
ad60: 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 r len [string le
ad70: 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 ngth $l]..}.
ad80: 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 }. set c [tls
ad90: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
ada0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
adb0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
adc0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
add0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
ade0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
adf0: 20 38 38 33 36 5d 0a 20 20 20 20 23 20 47 65 74 8836]. # Get
ae00: 20 74 68 65 20 62 75 66 66 65 72 69 6e 67 20 63 the buffering c
ae10: 6f 72 72 65 63 74 65 64 0a 20 20 20 20 66 63 6f orrected. fco
ae20: 6e 66 69 67 75 72 65 20 24 63 20 2d 62 75 66 66 nfigure $c -buff
ae30: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 23 ering line. #
ae40: 20 50 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f Put a byte into
ae50: 20 74 68 65 20 63 6c 69 65 6e 74 20 70 69 70 65 the client pipe
ae60: 20 74 6f 20 74 72 69 67 67 65 72 20 54 4c 53 20 to trigger TLS
ae70: 68 61 6e 64 73 68 61 6b 69 6e 67 0a 20 20 20 20 handshaking.
ae80: 70 75 74 73 20 24 63 20 61 0a 20 20 20 20 66 69 puts $c a. fi
ae90: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
aea0: 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 ble [list readli
aeb0: 74 74 6c 65 20 24 63 5d 0a 20 20 20 20 73 65 74 ttle $c]. set
aec0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
aed0: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
aee0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
aef0: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
af00: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
af10: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
af20: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 5f {close $socket_
af30: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
af40: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
af50: 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a $len.} {0 2690}.
af60: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
af70: 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 2 {testing EOF s
af80: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 tickyness} {unex
af90: 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 plainedFailure s
afa0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
afb0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
afc0: 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 71 . # remote eq
afd0: 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 33 0a uivalent of 9.3.
afe0: 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 # HOBBS: nev
aff0: 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 63 er worked correc
b000: 74 6c 79 0a 20 20 20 20 73 65 74 20 63 6f 75 6e tly. set coun
b010: 74 65 72 20 30 0a 20 20 20 20 73 65 74 20 64 6f ter 0. set do
b020: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 63 6f ne 0. proc co
b030: 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 6c unt_up {s} {..gl
b040: 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f 6e obal counter don
b050: 65 20 61 66 74 65 72 5f 69 64 0a 09 73 65 74 20 e after_id..set
b060: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 l [gets $s]..if
b070: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
b080: 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a 09 incr counter..
b090: 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 72 if {$counter
b0a0: 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 6f > 9} {...set do
b0b0: 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b ne {EOF is stick
b0c0: 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 y}...after cance
b0d0: 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 09 63 6c l $after_id...cl
b0e0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d ose $s.. }..}
b0f0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
b100: 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 timed_out {} {..
b110: 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 73 global c done..s
b120: 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f et done {timed_o
b130: 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 73 ut, EOF is not s
b140: 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 ticky}..close $c
b150: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
b160: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
b170: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
b180: 20 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 socket10_14_tes
b190: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
b1a0: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
b1b0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
b1c0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
b1d0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
b1e0: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
b1f0: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 accept 8836]..pr
b200: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
b210: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
b220: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
b230: 61 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 after 100 close
b240: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
b250: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
b260: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
b270: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
b280: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
b290: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
b2a0: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
b2b0: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
b2c0: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b2d0: 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e c readable "coun
b2e0: 74 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 74 t_up $c". set
b2f0: 20 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 72 after_id [after
b300: 20 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 1000 timed_out]
b310: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
b320: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b330: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
b340: 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _14_test_server}
b350: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 . set done.}
b360: 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a {EOF is sticky}.
b370: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
b380: 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 3 {testing async
b390: 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 6c write, async fl
b3a0: 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 ush, async close
b3b0: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
b3c0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b3d0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 rver} {. proc
b3e0: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
b3f0: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
b400: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
b410: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
b420: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
b430: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
b440: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
b450: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
b460: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e .}. }. sen
b470: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
b480: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
b490: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 et firstblock [s
b4a0: 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 tring repeat a 3
b4b0: 31 5d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 1]..set secondbl
b4c0: 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 ock [string repe
b4d0: 61 74 20 62 20 36 35 35 33 35 5d 0a 09 73 65 74 at b 65535]..set
b4e0: 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 l [tls::socket
b4f0: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
b500: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
b510: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b520: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
b530: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
b540: 20 38 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 8845]..proc acc
b550: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
b560: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
b570: 65 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 e $s.. fconfi
b580: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
b590: 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e g 0 -translation
b5a0: 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 lf -buffersize
b5b0: 31 36 33 38 34 20 5c 0a 09 09 20 20 20 20 2d 62 16384 \... -b
b5c0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 uffering line..
b5d0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
b5e0: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 readable "readab
b5f0: 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 le $s"..}..proc
b600: 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 readable {s} {..
b610: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
b620: 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 65 $s].. fileeve
b630: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b nt $s readable {
b640: 7d 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 }.. after 100
b650: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 0 respond $s..}.
b660: 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 .proc respond {s
b670: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
b680: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 firstblock..
b690: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
b6a0: 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 $s $firstblock..
b6b0: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 77 after 1000 w
b6c0: 72 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 ritedata $s..}..
b6d0: 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b proc writedata {
b6e0: 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c s} {.. global
b6f0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 secondblock..
b700: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
b710: 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 e $s $secondbloc
b720: 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a k.. close $s.
b730: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
b740: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
b750: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
b760: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
b770: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
b780: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
b790: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
b7a0: 65 72 76 65 72 49 50 20 38 38 34 35 5d 0a 20 20 erverIP 8845].
b7b0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
b7c0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 -blocking 0 -tra
b7d0: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
b7e0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
b7f0: 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 set count 0.
b800: 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 puts $s hello.
b810: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
b820: 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 eadable "readit
b830: 24 73 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $s". set time
b840: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
b850: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
b860: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
b870: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
b880: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
b890: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
b8a0: 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 se $l}. set c
b8b0: 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 ount.} 65566..te
b8c0: 73 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 st tlsIO-12.1 {t
b8d0: 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e esting inheritan
b8e0: 63 65 20 6f 66 20 73 65 72 76 65 72 20 73 6f 63 ce of server soc
b8f0: 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 kets} {socket ex
b900: 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 ec} {. makeFi
b910: 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 le {} script1.
b920: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
b930: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
b940: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
b950: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
b960: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
b970: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
b980: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
b990: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
b9a0: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
b9b0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
b9c0: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
b9d0: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
b9e0: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
b9f0: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
ba00: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
ba10: 20 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 # Script2 creat
ba20: 65 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f es the server so
ba30: 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 cket, launches s
ba40: 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 cript1,. # wa
ba50: 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e its a second, an
ba60: 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 d exits. The se
ba70: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c rver socket will
ba80: 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c now. # be cl
ba90: 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 osed unless scri
baa0: 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 pt1 inherited it
bab0: 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 ... set f [op
bac0: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
bad0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
bae0: 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c set tclsh $::tcl
baf0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 test::tcltest].
bb00: 20 20 20 70 75 74 73 20 24 66 20 7b 70 61 63 6b puts $f {pack
bb10: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 7d age require tls}
bb20: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
bb30: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
bb40: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
bb50: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
bb60: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
bb70: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
bb80: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
bb90: 79 20 38 38 32 38 5c 5d 22 0a 20 20 20 20 70 75 y 8828\]". pu
bba0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
bbb0: 63 65 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 cept { file addr
bbc0: 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 port } {.. c
bbd0: 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 lose $file..}..e
bbe0: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
bbf0: 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 t1 &..close $f..
bc00: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
bc10: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
bc20: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
bc30: 66 0a 09 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 f... # Launch
bc40: 20 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 69 script2 and wai
bc50: 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 t 5 seconds..
bc60: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
bc70: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
bc80: 32 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 30 2 &. after 50
bc90: 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 00 { set ok_to_p
bca0: 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 76 roceed 1 }. v
bcb0: 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 wait ok_to_proce
bcc0: 65 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 20 ed.. # If we
bcd0: 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 can still connec
bce0: 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 2c t to the server,
bcf0: 20 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 the socket got
bd00: 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 inherited...
bd10: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
bd20: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
bd30: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
bd40: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
bd50: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
bd60: 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 37 2e tKey \. . 127.
bd70: 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 0.0.1 8828} msg]
bd80: 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 76 } {..set x {serv
bd90: 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f er socket was no
bda0: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 t inherited}.
bdb0: 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 } else {..close
bdc0: 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 65 $msg..set x {se
bdd0: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
bde0: 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d inherited}. }
bdf0: 0a 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 .. set x.} {s
be00: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
be10: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
be20: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 .test tlsIO-12.2
be30: 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 {testing inheri
be40: 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 tance of client
be50: 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 sockets} {socket
be60: 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 6b exec} {. mak
be70: 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 31 eFile {} script1
be80: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d . makeFile {}
be90: 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 script2.. #
bea0: 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 Script1 is just
beb0: 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 a 10 second dela
bec0: 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 65 y. If the serve
bed0: 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 r socket. # i
bee0: 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 s inherited, it
bef0: 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 will be held ope
bf00: 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 n for 10 seconds
bf10: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
bf20: 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 n script1 w].
bf30: 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 puts $f {..afte
bf40: 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 r 10000 exit..vw
bf50: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
bf60: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
bf70: 20 20 20 20 23 20 53 63 72 69 70 74 32 20 6f 70 # Script2 op
bf80: 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 73 ens the client s
bf90: 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 73 ocket and writes
bfa0: 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 6e to it. It then
bfb0: 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 20 . # launches
bfc0: 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 74 script1 and exit
bfd0: 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c 64 s. If the child
bfe0: 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 74 process inherit
bff0: 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c 69 ed the. # cli
c000: 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 ent socket, the
c010: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c socket will stil
c020: 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 l be open...
c030: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
c040: 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt2 w]. puts
c050: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c $f [list set tcl
c060: 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 sh $::tcltest::t
c070: 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 cltest]. puts
c080: 20 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 71 $f {package req
c090: 75 69 72 65 20 74 6c 73 7d 0a 20 20 20 20 70 75 uire tls}. pu
c0a0: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
c0b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
c0c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
c0d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
c0e0: 20 5c 0a 09 20 20 20 20 2d 6b 65 79 66 69 6c 65 \.. -keyfile
c0f0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
c100: 30 2e 30 2e 31 20 38 38 32 39 5c 5d 22 0a 20 20 0.0.1 8829\]".
c110: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 78 65 puts $f {..exe
c120: 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 c $tclsh script1
c130: 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 &..puts $f test
c140: 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 ing..flush $f..a
c150: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
c160: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
c170: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
c180: 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 74 .. # Create t
c190: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
c1a0: 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 .. set server
c1b0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
c1c0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
c1d0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
c1e0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
c1f0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
c200: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
c210: 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 cept 8829]. p
c220: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
c230: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a e host port } {.
c240: 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c 69 65 .# When the clie
c250: 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 nt connects, est
c260: 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 64 20 ablish the read
c270: 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 handler..global
c280: 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 server..close $s
c290: 65 72 76 65 72 0a 09 66 63 6f 6e 66 69 67 75 72 erver..fconfigur
c2a0: 65 20 24 66 69 6c 65 20 2d 62 6c 6f 63 6b 69 6e e $file -blockin
c2b0: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 g 0..fileevent $
c2c0: 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5b 6c file readable [l
c2d0: 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 ist do_handshake
c2e0: 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 $file readable
c2f0: 67 65 74 64 61 74 61 20 5c 0a 09 09 2d 62 75 66 getdata \...-buf
c300: 66 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 09 72 65 fering line]..re
c310: 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 turn. }. p
c320: 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 roc getdata { fi
c330: 6c 65 20 7d 20 7b 0a 09 23 20 52 65 61 64 20 68 le } {..# Read h
c340: 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 andler on the ac
c350: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 09 cepted socket...
c360: 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c global x..global
c370: 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 failed..set sta
c380: 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 tus [catch {read
c390: 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 $file} data]..i
c3a0: 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d f {$status != 0}
c3b0: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 {.. set x {r
c3c0: 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f ead failed, erro
c3d0: 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 r was $data}..
c3e0: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
c3f0: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 $file }..} elsei
c400: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
c410: 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a re {} $data]} {.
c420: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f .} elseif {[fblo
c430: 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 cked $file]} {..
c440: 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 } elseif {[eof $
c450: 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 file]} {.. if
c460: 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 {$failed} {...s
c470: 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 et x {client soc
c480: 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 ket was inherite
c490: 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b d}.. } else {
c4a0: 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 ...set x {client
c4b0: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
c4c0: 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 inherited}..
c4d0: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
c4e0: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 lose $file }..}
c4f0: 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 else {.. set
c500: 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 x {impossible ca
c510: 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b se}.. catch {
c520: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
c530: 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a }..return. }.
c540: 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f . # If the so
c550: 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 cket doesn't hit
c560: 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 end-of-file in
c570: 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 5 seconds, the.
c580: 20 20 20 23 20 73 63 72 69 70 74 31 20 70 72 6f # script1 pro
c590: 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 cess must have i
c5a0: 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 nherited the cli
c5b0: 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ent... set fa
c5c0: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
c5d0: 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 5000 [list set
c5e0: 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 failed 1].. #
c5f0: 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 Launch the scri
c600: 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 pt2 process..
c610: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
c620: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
c630: 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 2 &.. vwait x
c640: 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 . if {!$faile
c650: 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c d} {..vwait fail
c660: 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 ed. }. set
c670: 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 x.} {client soc
c680: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
c690: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 rited}..test tls
c6a0: 49 4f 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 IO-12.3 {testing
c6b0: 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 inheritance of
c6c0: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 accepted sockets
c6d0: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 65 78 65 } \..{socket exe
c6e0: 63 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 c unixOnly} {.
c6f0: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 makeFile {} sc
c700: 72 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 ript1. makeFi
c710: 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 le {} script2..
c720: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
c730: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
c740: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
c750: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
c760: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
c770: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
c780: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
c790: 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt2 w]. puts
c7a0: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
c7b0: 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a lsh $::tcltest::
c7c0: 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 tcltest]. put
c7d0: 73 20 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 s $f {package re
c7e0: 71 75 69 72 65 20 74 6c 73 7d 0a 20 20 20 20 70 quire tls}. p
c7f0: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
c800: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
c810: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 ver accept \..
c820: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
c830: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
c840: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
c850: 20 24 73 65 72 76 65 72 4b 65 79 20 38 39 33 30 $serverKey 8930
c860: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
c870: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
c880: 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 file host port
c890: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
c8a0: 74 63 6c 73 68 0a 09 20 20 20 20 66 63 6f 6e 66 tclsh.. fconf
c8b0: 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 igure $file -buf
c8c0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
c8d0: 20 70 75 74 73 20 24 66 69 6c 65 20 7b 74 65 73 puts $file {tes
c8e0: 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 74 t data on socket
c8f0: 7d 0a 09 20 20 20 20 65 78 65 63 20 24 74 63 6c }.. exec $tcl
c900: 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 20 20 sh script1 &..
c910: 20 20 61 66 74 65 72 20 31 30 30 30 20 65 78 69 after 1000 exi
c920: 74 0a 09 7d 0a 09 76 77 61 69 74 20 66 6f 72 65 t..}..vwait fore
c930: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
c940: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 ose $f.. # La
c950: 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 32 unch the script2
c960: 20 70 72 6f 63 65 73 73 20 61 6e 64 20 63 6f 6e process and con
c970: 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 53 65 65 nect to it. See
c980: 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 23 20 how long. #
c990: 74 68 65 20 73 6f 63 6b 65 74 20 73 74 61 79 73 the socket stays
c9a0: 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 65 63 20 open.. exec
c9b0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
c9c0: 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 est script2 &..
c9d0: 20 20 20 61 66 74 65 72 20 32 30 30 30 20 73 65 after 2000 se
c9e0: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 t ok_to_proceed
c9f0: 31 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 1. vwait ok_t
ca00: 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 73 o_proceed.. s
ca10: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
ca20: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
ca30: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
ca40: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
ca50: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
ca60: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
ca70: 30 2e 31 20 38 39 33 30 5d 0a 20 20 20 20 66 63 0.1 8930]. fc
ca80: 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 62 75 66 onfigure $f -buf
ca90: 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f fering full -blo
caa0: 63 6b 69 6e 67 20 30 0a 20 20 20 20 23 20 57 65 cking 0. # We
cab0: 20 6e 65 65 64 20 74 6f 20 70 75 74 20 61 20 62 need to put a b
cac0: 79 74 65 20 69 6e 74 6f 20 74 68 65 20 72 65 61 yte into the rea
cad0: 64 20 71 75 65 75 65 2c 20 6f 74 68 65 72 77 69 d queue, otherwi
cae0: 73 65 20 74 68 65 0a 20 20 20 20 23 20 54 4c 53 se the. # TLS
caf0: 20 68 61 6e 64 73 68 61 6b 65 20 64 6f 65 73 6e handshake doesn
cb00: 27 74 20 66 69 6e 69 73 68 0a 20 20 20 20 70 75 't finish. pu
cb10: 74 73 20 24 66 20 61 3b 20 66 6c 75 73 68 20 24 ts $f a; flush $
cb20: 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 f. fileevent
cb30: 24 66 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $f readable [lis
cb40: 74 20 67 65 74 64 61 74 61 20 24 66 5d 0a 0a 20 t getdata $f]..
cb50: 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b # If the sock
cb60: 65 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e et is still open
cb70: 20 61 66 74 65 72 20 35 20 73 65 63 6f 6e 64 73 after 5 seconds
cb80: 2c 20 74 68 65 20 73 63 72 69 70 74 31 20 70 72 , the script1 pr
cb90: 6f 63 65 73 73 0a 20 20 20 20 23 20 6d 75 73 74 ocess. # must
cba0: 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 have inherited
cbb0: 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 the accepted soc
cbc0: 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ket... set fa
cbd0: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
cbe0: 20 35 30 30 30 20 73 65 74 20 66 61 69 6c 65 64 5000 set failed
cbf0: 20 31 0a 0a 20 20 20 20 70 72 6f 63 20 67 65 74 1.. proc get
cc00: 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a data { file } {.
cc10: 09 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 20 .# Read handler
cc20: 6f 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f on the client so
cc30: 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a cket...global x.
cc40: 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 09 .global failed..
cc50: 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 set status [catc
cc60: 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 h {read $file} d
cc70: 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 75 ata]..if {$statu
cc80: 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 s != 0} {.. s
cc90: 65 74 20 78 20 22 72 65 61 64 20 66 61 69 6c 65 et x "read faile
cca0: 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 61 d, error was $da
ccb0: 74 61 22 0a 09 20 20 20 20 63 61 74 63 68 20 7b ta".. catch {
ccc0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
ccd0: 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e } elseif {[strin
cce0: 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 g compare {} $da
ccf0: 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 ta]} {..} elseif
cd00: 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c {[fblocked $fil
cd10: 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 e]} {..} elseif
cd20: 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a {[eof $file]} {.
cd30: 09 20 20 20 20 69 66 20 7b 24 66 61 69 6c 65 64 . if {$failed
cd40: 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 63 } {...set x {acc
cd50: 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 epted socket was
cd60: 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 inherited}..
cd70: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 } else {...set
cd80: 78 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b x {accepted sock
cd90: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
cda0: 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 ited}.. }..
cdb0: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
cdc0: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 $file }..} else
cdd0: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 6d {.. set x {im
cde0: 70 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 possible case}..
cdf0: 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 catch { clos
ce00: 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 e $file }..}..re
ce10: 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 0a turn. }. .
ce20: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
ce30: 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 set x.} {accepte
ce40: 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 d socket was not
ce50: 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 inherited}..tes
ce60: 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 7b 54 65 t tlsIO-13.1 {Te
ce70: 73 74 69 6e 67 20 75 73 65 20 6f 66 20 73 68 61 sting use of sha
ce80: 72 65 64 20 73 6f 63 6b 65 74 20 62 65 74 77 65 red socket betwe
ce90: 65 6e 20 74 77 6f 20 74 68 72 65 61 64 73 7d 20 en two threads}
cea0: 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 \..{socket testt
ceb0: 68 72 65 61 64 7d 20 7b 0a 20 20 20 20 23 20 48 hread} {. # H
cec0: 4f 42 42 53 3a 20 6e 65 76 65 72 20 74 65 73 74 OBBS: never test
ced0: 65 64 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c ed. removeFil
cee0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 74 68 72 e script. thr
cef0: 65 61 64 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b eadReap.. mak
cf00: 65 46 69 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 eFile {. .pac
cf10: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
cf20: 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f ..set f [tls::so
cf30: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
cf40: 65 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 ept 8828]..proc
cf50: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
cf60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
cf70: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
cf80: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
cf90: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 ]. fc
cfa0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
cfb0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
cfc0: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
cfd0: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f {s} {.. glo
cfe0: 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 bal i.
cff0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
d000: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
d010: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
d020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d030: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
d040: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
d050: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
d060: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
d070: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 } e
d080: 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 lse { ..
d090: 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 incr i.
d0a0: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
d0b0: 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 $l.
d0c0: 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 }..}..set i 0..
d0d0: 76 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 vwait x..close $
d0e0: 66 0a 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 f...# thread cle
d0f0: 61 6e 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 ans itself up...
d100: 74 65 73 74 74 68 72 65 61 64 20 65 78 69 74 0a testthread exit.
d110: 20 20 20 20 7d 20 73 63 72 69 70 74 0a 20 20 20 } script.
d120: 20 0a 20 20 20 20 23 20 63 72 65 61 74 65 20 61 . # create a
d130: 20 74 68 72 65 61 64 0a 20 20 20 20 73 65 74 20 thread. set
d140: 73 65 72 76 65 72 74 68 72 65 61 64 20 5b 74 65 serverthread [te
d150: 73 74 74 68 72 65 61 64 20 63 72 65 61 74 65 20 stthread create
d160: 7b 20 73 6f 75 72 63 65 20 73 63 72 69 70 74 20 { source script
d170: 7d 20 5d 0a 20 20 20 20 75 70 64 61 74 65 0a 20 } ]. update.
d180: 20 20 20 0a 20 20 20 20 61 66 74 65 72 20 31 30 . after 10
d190: 30 30 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 00. set s [tl
d1a0: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
d1b0: 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 0.1 8828]. fc
d1c0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
d1d0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 fering line..
d1e0: 20 63 61 74 63 68 20 7b 0a 09 70 75 74 73 20 24 catch {..puts $
d1f0: 73 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 s "hello"..gets
d200: 24 73 20 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a $s result. }.
d210: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
d220: 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 74 update.. aft
d230: 65 72 20 32 30 30 30 0a 20 20 20 20 6c 61 70 70 er 2000. lapp
d240: 65 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 72 65 end result [thre
d250: 61 64 52 65 61 70 5d 0a 20 20 20 20 0a 20 20 20 adReap]. .
d260: 20 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b set result..} {
d270: 68 65 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c 65 61 hello 1}..# clea
d280: 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 20 nup.if {[string
d290: 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f 6d match sock* $com
d2a0: 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 mandSocket] == 1
d2b0: 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 6d } {. puts $com
d2c0: 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 0a mandSocket exit.
d2d0: 20 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 6e flush $comman
d2e0: 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 20 dSocket.}.catch
d2f0: 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 {close $commandS
d300: 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 6c ocket}.catch {cl
d310: 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 43 ose $remoteProcC
d320: 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a han}.::tcltest::
d330: 63 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 6c 75 cleanupTests.flu
d340: 73 68 20 73 74 64 6f 75 74 0a 72 65 74 75 72 6e sh stdout.return
d350: 0a .