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 35 20 32 30 30 30 2f 30 36 2f 30 35 20 32 32 .5 2000/06/05 22
0210: 3a 35 37 3a 35 38 20 73 74 61 6e 74 6f 6e 20 45 :57:58 stanton E
0220: 78 70 20 24 0a 0a 23 20 52 75 6e 6e 69 6e 67 20 xp $..# Running
0230: 73 6f 63 6b 65 74 20 74 65 73 74 73 20 77 69 74 socket tests wit
0240: 68 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 h a remote serve
0250: 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d r:.# -----------
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 2d 0a ---------------.
0280: 23 20 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 # .# Some tests
0290: 69 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 64 in socket.test d
02a0: 65 70 65 6e 64 20 6f 6e 20 74 68 65 20 65 78 69 epend on the exi
02b0: 73 74 65 6e 63 65 20 6f 66 20 61 20 72 65 6d 6f stence of a remo
02c0: 74 65 20 73 65 72 76 65 72 20 74 6f 0a 23 20 77 te server to.# w
02d0: 68 69 63 68 20 74 68 65 79 20 63 6f 6e 6e 65 63 hich they connec
02e0: 74 2e 20 54 68 65 20 72 65 6d 6f 74 65 20 73 65 t. The remote se
02f0: 72 76 65 72 20 6d 75 73 74 20 62 65 20 61 6e 20 rver must be an
0300: 69 6e 73 74 61 6e 63 65 20 6f 66 20 74 63 6c 74 instance of tclt
0310: 65 73 74 20 61 6e 64 20 69 74 0a 23 20 6d 75 73 est and it.# mus
0320: 74 20 72 75 6e 20 74 68 65 20 73 63 72 69 70 74 t run the script
0330: 20 66 6f 75 6e 64 20 69 6e 20 74 68 65 20 66 69 found in the fi
0340: 6c 65 20 22 72 65 6d 6f 74 65 2e 74 63 6c 22 20 le "remote.tcl"
0350: 69 6e 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 in this director
0360: 79 2e 20 59 6f 75 0a 23 20 63 61 6e 20 73 74 61 y. You.# can sta
0370: 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 rt the remote se
0380: 72 76 65 72 20 6f 6e 20 61 6e 79 20 6d 61 63 68 rver on any mach
0390: 69 6e 65 20 72 65 61 63 68 61 62 6c 65 20 66 72 ine reachable fr
03a0: 6f 6d 20 74 68 65 20 6d 61 63 68 69 6e 65 20 6f om the machine o
03b0: 6e 0a 23 20 77 68 69 63 68 20 79 6f 75 20 77 61 n.# which you wa
03c0: 6e 74 20 74 6f 20 72 75 6e 20 74 68 65 20 73 6f nt to run the so
03d0: 63 6b 65 74 20 74 65 73 74 73 2c 20 62 79 20 69 cket tests, by i
03e0: 73 73 75 69 6e 67 3a 0a 23 20 0a 23 20 20 20 20 ssuing:.# .#
03f0: 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e tcltest remote.
0400: 74 63 6c 20 2d 70 6f 72 74 20 32 30 34 38 09 23 tcl -port 2048.#
0410: 20 4f 72 20 63 68 6f 6f 73 65 20 61 6e 6f 74 68 Or choose anoth
0420: 65 72 20 70 6f 72 74 20 6e 75 6d 62 65 72 2e 0a er port number..
0430: 23 20 0a 23 20 49 66 20 74 68 65 20 6d 61 63 68 # .# If the mach
0440: 69 6e 65 20 79 6f 75 20 61 72 65 20 72 75 6e 6e ine you are runn
0450: 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 20 73 ing the remote s
0460: 65 72 76 65 72 20 6f 6e 20 68 61 73 20 73 65 76 erver on has sev
0470: 65 72 61 6c 20 49 50 0a 23 20 69 6e 74 65 72 66 eral IP.# interf
0480: 61 63 65 73 2c 20 79 6f 75 20 63 61 6e 20 63 68 aces, you can ch
0490: 6f 6f 73 65 20 77 68 69 63 68 20 69 6e 74 65 72 oose which inter
04a0: 66 61 63 65 20 74 68 65 20 73 65 72 76 65 72 20 face the server
04b0: 6c 69 73 74 65 6e 73 20 6f 6e 20 66 6f 72 0a 23 listens on for.#
04c0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 62 79 20 connections by
04d0: 73 70 65 63 69 66 79 69 6e 67 20 74 68 65 20 2d specifying the -
04e0: 61 64 64 72 65 73 73 20 63 6f 6d 6d 61 6e 64 20 address command
04f0: 6c 69 6e 65 20 66 6c 61 67 2c 20 73 6f 3a 0a 23 line flag, so:.#
0500: 20 0a 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 .# tcltest
0510: 72 65 6d 6f 74 65 2e 74 63 6c 20 2d 61 64 64 72 remote.tcl -addr
0520: 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 ess your.machine
0530: 2e 63 6f 6d 0a 23 20 0a 23 20 54 68 65 73 65 20 .com.# .# These
0540: 6f 70 74 69 6f 6e 73 20 63 61 6e 20 61 6c 73 6f options can also
0550: 20 62 65 20 73 65 74 20 62 79 20 65 6e 76 69 72 be set by envir
0560: 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 onment variables
0570: 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 6f 75 20 63 . On Unix, you c
0580: 61 6e 0a 23 20 74 79 70 65 20 74 68 65 73 65 20 an.# type these
0590: 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 commands to the
05a0: 73 68 65 6c 6c 20 66 72 6f 6d 20 77 68 69 63 68 shell from which
05b0: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
05c0: 65 72 20 69 73 20 73 74 61 72 74 65 64 3a 0a 23 er is started:.#
05d0: 20 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 .# shell% s
05e0: 65 74 65 6e 76 20 73 65 72 76 65 72 50 6f 72 74 etenv serverPort
05f0: 20 32 30 34 38 0a 23 20 20 20 20 20 73 68 65 6c 2048.# shel
0600: 6c 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 l% setenv server
0610: 41 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 Address your.mac
0620: 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 61 6e hine.com.# .# an
0630: 64 20 73 75 62 73 65 71 75 65 6e 74 6c 79 20 79 d subsequently y
0640: 6f 75 20 63 61 6e 20 73 74 61 72 74 20 74 68 65 ou can start the
0650: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 77 remote server w
0660: 69 74 68 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 ith:.# .# tc
0670: 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c ltest remote.tcl
0680: 0a 23 20 0a 23 20 74 6f 20 68 61 76 65 20 69 74 .# .# to have it
0690: 20 6c 69 73 74 65 6e 20 6f 6e 20 70 6f 72 74 20 listen on port
06a0: 32 30 34 38 20 6f 6e 20 74 68 65 20 69 6e 74 65 2048 on the inte
06b0: 72 66 61 63 65 20 79 6f 75 72 2e 6d 61 63 68 69 rface your.machi
06c0: 6e 65 2e 63 6f 6d 2e 0a 23 20 20 20 20 20 0a 23 ne.com..# .#
06d0: 20 57 68 65 6e 20 74 68 65 20 73 65 72 76 65 72 When the server
06e0: 20 73 74 61 72 74 73 2c 20 69 74 20 70 72 69 6e starts, it prin
06f0: 74 73 20 6f 75 74 20 61 20 64 65 74 61 69 6c 65 ts out a detaile
0700: 64 20 6d 65 73 73 61 67 65 20 63 6f 6e 74 61 69 d message contai
0710: 6e 69 6e 67 20 69 74 73 0a 23 20 63 6f 6e 66 69 ning its.# confi
0720: 67 75 72 61 74 69 6f 6e 20 69 6e 66 6f 72 6d 61 guration informa
0730: 74 69 6f 6e 2c 20 61 6e 64 20 69 74 20 77 69 6c tion, and it wil
0740: 6c 20 62 6c 6f 63 6b 20 75 6e 74 69 6c 20 6b 69 l block until ki
0750: 6c 6c 65 64 20 77 69 74 68 20 61 20 43 74 72 6c lled with a Ctrl
0760: 2d 43 2e 0a 23 20 4f 6e 63 65 20 74 68 65 20 72 -C..# Once the r
0770: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 65 78 69 emote server exi
0780: 73 74 73 2c 20 79 6f 75 20 63 61 6e 20 72 75 6e sts, you can run
0790: 20 74 68 65 20 74 65 73 74 73 20 69 6e 20 73 6f the tests in so
07a0: 63 6b 65 74 2e 74 65 73 74 20 77 69 74 68 0a 23 cket.test with.#
07b0: 20 74 68 65 20 73 65 72 76 65 72 20 62 79 20 73 the server by s
07c0: 65 74 74 69 6e 67 20 74 77 6f 20 54 63 6c 20 76 etting two Tcl v
07d0: 61 72 69 61 62 6c 65 73 3a 0a 23 20 0a 23 20 20 ariables:.# .#
07e0: 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 % set remoteS
07f0: 65 72 76 65 72 49 50 20 3c 6e 61 6d 65 20 6f 72 erverIP <name or
0800: 20 61 64 64 72 65 73 73 20 6f 66 20 6d 61 63 68 address of mach
0810: 69 6e 65 20 6f 6e 20 77 68 69 63 68 20 73 65 72 ine on which ser
0820: 76 65 72 20 72 75 6e 73 3e 0a 23 20 20 20 20 20 ver runs>.#
0830: 25 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 % set remoteServ
0840: 65 72 50 6f 72 74 20 32 30 34 38 0a 23 20 0a 23 erPort 2048.# .#
0850: 20 54 68 65 73 65 20 76 61 72 69 61 62 6c 65 73 These variables
0860: 20 61 72 65 20 61 6c 73 6f 20 73 65 74 74 61 62 are also settab
0870: 6c 65 20 66 72 6f 6d 20 74 68 65 20 65 6e 76 69 le from the envi
0880: 72 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 55 6e 69 78 ronment. On Unix
0890: 2c 20 79 6f 75 20 63 61 6e 3a 0a 23 20 0a 23 20 , you can:.# .#
08a0: 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e shell% seten
08b0: 76 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 v remoteServerIP
08c0: 20 6d 61 63 68 69 6e 65 2e 77 68 65 72 65 2e 73 machine.where.s
08d0: 65 72 76 65 72 2e 72 75 6e 73 0a 23 20 20 20 20 erver.runs.#
08e0: 20 73 68 65 6c 6c 25 20 73 65 6e 65 74 76 20 72 shell% senetv r
08f0: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 emoteServerPort
0900: 32 30 34 38 0a 23 20 0a 23 20 54 68 65 20 70 72 2048.# .# The pr
0910: 65 61 6d 62 6c 65 20 6f 66 20 74 68 65 20 73 6f eamble of the so
0920: 63 6b 65 74 2e 74 65 73 74 20 66 69 6c 65 20 63 cket.test file c
0930: 68 65 63 6b 73 20 74 6f 20 73 65 65 20 69 66 20 hecks to see if
0940: 74 68 65 20 76 61 72 69 61 62 6c 65 73 20 61 72 the variables ar
0950: 65 20 73 65 74 0a 23 20 65 69 74 68 65 72 20 69 e set.# either i
0960: 6e 20 54 63 6c 20 6f 72 20 69 6e 20 74 68 65 20 n Tcl or in the
0970: 65 6e 76 69 72 6f 6e 6d 65 6e 74 3b 20 69 66 20 environment; if
0980: 74 68 65 79 20 61 72 65 2c 20 69 74 20 61 74 74 they are, it att
0990: 65 6d 70 74 73 20 74 6f 20 63 6f 6e 6e 65 63 74 empts to connect
09a0: 20 74 6f 0a 23 20 74 68 65 20 73 65 72 76 65 72 to.# the server
09b0: 2e 20 49 66 20 74 68 65 20 63 6f 6e 6e 65 63 74 . If the connect
09c0: 69 6f 6e 20 69 73 20 73 75 63 63 65 73 73 66 75 ion is successfu
09d0: 6c 2c 20 74 68 65 20 74 65 73 74 73 20 75 73 69 l, the tests usi
09e0: 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 ng the remote.#
09f0: 73 65 72 76 65 72 20 77 69 6c 6c 20 62 65 20 70 server will be p
0a00: 65 72 66 6f 72 6d 65 64 3b 20 6f 74 68 65 72 77 erformed; otherw
0a10: 69 73 65 2c 20 69 74 20 77 69 6c 6c 20 61 74 74 ise, it will att
0a20: 65 6d 70 74 20 74 6f 20 73 74 61 72 74 20 74 68 empt to start th
0a30: 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 e remote.# serve
0a40: 72 20 28 76 69 61 20 65 78 65 63 29 20 6f 6e 20 r (via exec) on
0a50: 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 73 platforms that s
0a60: 75 70 70 6f 72 74 20 74 68 69 73 2c 20 6f 6e 20 upport this, on
0a70: 74 68 65 20 6c 6f 63 61 6c 20 68 6f 73 74 2c 0a the local host,.
0a80: 23 20 6c 69 73 74 65 6e 69 6e 67 20 61 74 20 70 # listening at p
0a90: 6f 72 74 20 32 30 34 38 2e 20 49 66 20 61 6c 6c ort 2048. If all
0aa0: 20 66 61 69 6c 73 2c 20 61 20 6d 65 73 73 61 67 fails, a messag
0ab0: 65 20 69 73 20 70 72 69 6e 74 65 64 20 61 6e 64 e is printed and
0ac0: 20 74 68 65 20 74 65 73 74 73 0a 23 20 75 73 69 the tests.# usi
0ad0: 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 ng the remote se
0ae0: 72 76 65 72 20 61 72 65 20 6e 6f 74 20 70 65 72 rver are not per
0af0: 66 6f 72 6d 65 64 2e 0a 0a 69 66 20 7b 5b 6c 73 formed...if {[ls
0b00: 65 61 72 63 68 20 5b 6e 61 6d 65 73 70 61 63 65 earch [namespace
0b10: 20 63 68 69 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c children] ::tcl
0b20: 74 65 73 74 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 test] == -1} {.
0b30: 20 20 20 70 61 63 6b 61 67 65 20 72 65 71 75 69 package requi
0b40: 72 65 20 74 63 6c 74 65 73 74 0a 20 20 20 20 6e re tcltest. n
0b50: 61 6d 65 73 70 61 63 65 20 69 6d 70 6f 72 74 20 amespace import
0b60: 2d 66 6f 72 63 65 20 3a 3a 74 63 6c 74 65 73 74 -force ::tcltest
0b70: 3a 3a 2a 0a 7d 0a 0a 23 20 4c 6f 61 64 20 74 68 ::*.}..# Load th
0b80: 65 20 74 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 e tls package.pa
0b90: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
0ba0: 73 0a 0a 73 65 74 20 63 65 72 74 73 44 69 72 20 s..set certsDir
0bb0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 [file join [file
0bc0: 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 dirname [info s
0bd0: 63 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 20 0a cript]] certs] .
0be0: 0a 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 .set serverCert
0bf0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
0c00: 73 44 69 72 20 73 65 72 76 65 72 2e 70 65 6d 5d sDir server.pem]
0c10: 0a 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 .set clientCert
0c20: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
0c30: 73 44 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d sDir client.pem]
0c40: 0a 73 65 74 20 63 61 43 65 72 74 20 5b 66 69 6c .set caCert [fil
0c50: 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 e join $certsDir
0c60: 20 63 61 63 65 72 74 2e 70 65 6d 5d 0a 73 65 74 cacert.pem].set
0c70: 20 73 65 72 76 65 72 4b 65 79 20 5b 66 69 6c 65 serverKey [file
0c80: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
0c90: 73 6b 65 79 2e 70 65 6d 5d 0a 73 65 74 20 63 6c skey.pem].set cl
0ca0: 69 65 6e 74 4b 65 79 20 5b 66 69 6c 65 20 6a 6f ientKey [file jo
0cb0: 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 6b 65 in $certsDir cke
0cc0: 79 2e 70 65 6d 5d 0a 0a 23 20 53 6f 6d 65 20 74 y.pem]..# Some t
0cd0: 65 73 74 73 20 72 65 71 75 69 72 65 20 74 68 65 ests require the
0ce0: 20 74 65 73 74 74 68 72 65 61 64 20 63 6f 6d 6d testthread comm
0cf0: 61 6e 64 0a 0a 73 65 74 20 3a 3a 74 63 6c 74 65 and..set ::tclte
0d00: 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 st::testConstrai
0d10: 6e 74 73 28 74 65 73 74 74 68 72 65 61 64 29 20 nts(testthread)
0d20: 5c 0a 09 5b 65 78 70 72 20 7b 5b 69 6e 66 6f 20 \..[expr {[info
0d30: 63 6f 6d 6d 61 6e 64 73 20 74 65 73 74 74 68 72 commands testthr
0d40: 65 61 64 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a ead] != {}}]..#.
0d50: 23 20 49 66 20 72 65 6d 6f 74 65 53 65 72 76 65 # If remoteServe
0d60: 72 49 50 20 6f 72 20 72 65 6d 6f 74 65 53 65 72 rIP or remoteSer
0d70: 76 65 72 50 6f 72 74 20 61 72 65 20 6e 6f 74 20 verPort are not
0d80: 73 65 74 2c 20 63 68 65 63 6b 20 69 6e 20 74 68 set, check in th
0d90: 65 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 e.# environment
0da0: 76 61 72 69 61 62 6c 65 73 20 66 6f 72 20 65 78 variables for ex
0db0: 74 65 72 6e 61 6c 6c 79 20 73 65 74 20 76 61 6c ternally set val
0dc0: 75 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e ues..#..if {![in
0dd0: 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 fo exists remote
0de0: 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 20 20 20 ServerIP]} {.
0df0: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 if {[info exist
0e00: 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 s env(remoteServ
0e10: 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 72 erIP)]} {..set r
0e20: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 65 emoteServerIP $e
0e30: 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 nv(remoteServerI
0e40: 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 P). }.}.if {!
0e50: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
0e60: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 oteServerPort]}
0e70: 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 {. if {[info
0e80: 65 78 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 exists env(remot
0e90: 65 53 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 eServerIP)]} {..
0ea0: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
0eb0: 50 6f 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 65 Port $env(remote
0ec0: 53 65 72 76 65 72 50 6f 72 74 29 0a 20 20 20 20 ServerPort).
0ed0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
0ee0: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 if {[info exist
0ef0: 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 s remoteServerIP
0f00: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 ]} {.. set re
0f10: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 32 moteServerPort 2
0f20: 30 34 38 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 048. }.
0f30: 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 6b }.}..#.# Check
0f40: 20 69 66 20 77 65 27 72 65 20 73 75 70 70 6f 73 if we're suppos
0f50: 65 64 20 74 6f 20 64 6f 20 74 65 73 74 73 20 61 ed to do tests a
0f60: 67 61 69 6e 73 74 20 74 68 65 20 72 65 6d 6f 74 gainst the remot
0f70: 65 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 20 e server.#..set
0f80: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
0f90: 65 53 65 72 76 65 72 20 31 0a 69 66 20 7b 21 5b eServer 1.if {![
0fa0: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
0fb0: 74 65 53 65 72 76 65 72 49 50 5d 20 26 26 20 28 teServerIP] && (
0fc0: 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c $tcl_platform(pl
0fd0: 61 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 69 atform) != "maci
0fe0: 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 73 ntosh")} {. s
0ff0: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 et remoteServerI
1000: 50 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 66 P 127.0.0.1.}.if
1010: 20 7b 28 24 64 6f 54 65 73 74 73 57 69 74 68 52 {($doTestsWithR
1020: 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 emoteServer == 1
1030: 29 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 69 ) && (![info exi
1040: 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 sts remoteServer
1050: 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 65 Port])} {. se
1060: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
1070: 72 74 20 32 30 34 38 0a 7d 0a 0a 23 20 41 74 74 rt 2048.}..# Att
1080: 65 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 empt to connect
1090: 74 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 to a remote serv
10a0: 65 72 20 69 66 20 6f 6e 65 20 69 73 20 61 6c 72 er if one is alr
10b0: 65 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 66 eady running. If
10c0: 20 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 6e it.# is not run
10d0: 6e 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d 65 ning or for some
10e0: 20 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 74 68 other reason th
10f0: 65 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 2c e connect fails,
1100: 20 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 74 attempt to.# st
1110: 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 art the remote s
1120: 65 72 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f 63 erver on the loc
1130: 61 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 6e al host listenin
1140: 67 20 6f 6e 20 70 6f 72 74 20 32 30 34 38 2e 20 g on port 2048.
1150: 54 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 64 This.# is only d
1160: 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 one on platforms
1170: 20 74 68 61 74 20 73 75 70 70 6f 72 74 20 65 78 that support ex
1180: 65 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e 20 ec (i.e. not on
1190: 74 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 70 the Mac). On.# p
11a0: 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 64 6f latforms that do
11b0: 20 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 78 65 not support exe
11c0: 63 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 c, the remote se
11d0: 72 76 65 72 20 6d 75 73 74 20 62 65 20 73 74 61 rver must be sta
11e0: 72 74 65 64 0a 23 20 62 79 20 74 68 65 20 75 73 rted.# by the us
11f0: 65 72 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e er before runnin
1200: 67 20 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 65 g the tests...se
1210: 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e t remoteProcChan
1220: 20 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 53 "".set commandS
1230: 6f 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 6f ocket "".if {$do
1240: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1250: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 74 erver} {. cat
1260: 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 ch {close $comma
1270: 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 66 ndSocket}. if
1280: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f {[catch {set co
1290: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 mmandSocket [tls
12a0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
12b0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
12c0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
12d0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
12e0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
12f0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
1300: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
1310: 65 72 76 65 72 50 6f 72 74 5d 7d 5d 20 21 3d 20 erverPort]}] !=
1320: 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 0} {..if {[info
1330: 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d 20 3d commands exec] =
1340: 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 73 65 74 = ""} {.. set
1350: 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 noRemoteTestRea
1360: 73 6f 6e 20 22 63 61 6e 27 74 20 65 78 65 63 22 son "can't exec"
1370: 0a 09 20 20 20 20 73 65 74 20 64 6f 54 65 73 74 .. set doTest
1380: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
1390: 72 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 r 0..} else {..
13a0: 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 set remoteSer
13b0: 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a verIP 127.0.0.1.
13c0: 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 46 . set remoteF
13d0: 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b ile [file join [
13e0: 70 77 64 5d 20 72 65 6d 6f 74 65 2e 74 63 6c 5d pwd] remote.tcl]
13f0: 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 .. if {[catch
1400: 20 7b 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 {set remoteProc
1410: 43 68 61 6e 20 5c 0a 09 09 09 09 5b 6f 70 65 6e Chan \.....[open
1420: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
1430: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 24 72 65 est::tcltest $re
1440: 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 09 09 09 09 moteFile \......
1450: 2d 73 65 72 76 65 72 49 73 53 69 6c 65 6e 74 20 -serverIsSilent
1460: 5c 0a 09 09 09 09 09 2d 70 6f 72 74 20 24 72 65 \......-port $re
1470: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 5c moteServerPort \
1480: 0a 09 09 09 09 09 2d 61 64 64 72 65 73 73 20 24 ......-address $
1490: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 22 remoteServerIP]"
14a0: 20 5c 0a 09 09 09 09 09 77 2b 5d 7d 20 5c 0a 09 \......w+]} \..
14b0: 09 20 20 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b . msg] == 0} {
14c0: 0a 09 09 61 66 74 65 72 20 31 30 30 30 0a 09 09 ...after 1000...
14d0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 if {[catch {set
14e0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 commandSocket [t
14f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 20 ls::socket \...
1500: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
1510: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
1520: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
1530: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
1540: 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 ...$remoteServer
1550: 49 50 20 5c 0a 09 09 09 09 24 72 65 6d 6f 74 65 IP \.....$remote
1560: 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 ServerPort]} msg
1570: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 ] == 0} {...
1580: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d fconfigure $comm
1590: 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 andSocket -trans
15a0: 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 lation crlf -buf
15b0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 7d 20 fering line...}
15c0: 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 65 74 else {... set
15d0: 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 noRemoteTestRea
15e0: 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 20 73 son $msg... s
15f0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
1600: 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 09 7d moteServer 0...}
1610: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
1620: 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 .set noRemoteTes
1630: 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 24 3a tReason "$msg $:
1640: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
1650: 74 22 0a 09 09 73 65 74 20 64 6f 54 65 73 74 73 t"...set doTests
1660: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
1670: 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 0.. }..}.
1680: 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f 6e 66 } else {..fconf
1690: 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f igure $commandSo
16a0: 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f cket -translatio
16b0: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
16c0: 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d 0a 0a g line. }.}..
16d0: 23 20 53 6f 6d 65 20 74 65 73 74 73 20 61 72 65 # Some tests are
16e0: 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 65 20 run only if we
16f0: 61 72 65 20 64 6f 69 6e 67 20 74 65 73 74 69 6e are doing testin
1700: 67 20 61 67 61 69 6e 73 74 20 61 20 72 65 6d 6f g against a remo
1710: 74 65 20 73 65 72 76 65 72 2e 0a 73 65 74 20 3a te server..set :
1720: 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f :tcltest::testCo
1730: 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 65 73 74 nstraints(doTest
1740: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
1750: 72 29 20 24 64 6f 54 65 73 74 73 57 69 74 68 52 r) $doTestsWithR
1760: 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 20 7b emoteServer.if {
1770: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
1780: 74 65 53 65 72 76 65 72 20 3d 3d 20 30 7d 20 7b teServer == 0} {
1790: 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 . if {[string
17a0: 20 66 69 72 73 74 20 73 20 24 3a 3a 74 63 6c 74 first s $::tclt
17b0: 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 21 3d est::verbose] !=
17c0: 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 74 73 -1} {. .puts
17d0: 20 22 53 6b 69 70 70 69 6e 67 20 74 65 73 74 73 "Skipping tests
17e0: 20 77 69 74 68 20 72 65 6d 6f 74 65 20 73 65 72 with remote ser
17f0: 76 65 72 2e 20 53 65 65 20 74 65 73 74 73 2f 73 ver. See tests/s
1800: 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 22 0a ocket.test for".
1810: 09 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 74 69 .puts "informati
1820: 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 75 6e on on how to run
1830: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 22 remote server."
1840: 0a 09 70 75 74 73 20 22 52 65 61 73 6f 6e 20 66 ..puts "Reason f
1850: 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 65 6d or not doing rem
1860: 6f 74 65 20 74 65 73 74 73 3a 20 24 6e 6f 52 65 ote tests: $noRe
1870: 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 22 0a moteTestReason".
1880: 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 }.}..#.# If
1890: 77 65 20 64 6f 20 74 68 65 20 74 65 73 74 73 2c we do the tests,
18a0: 20 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d 61 6e define a comman
18b0: 64 20 74 6f 20 73 65 6e 64 20 61 20 63 6f 6d 6d d to send a comm
18c0: 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 65 6d and to the.# rem
18d0: 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 0a 0a 69 ote server..#..i
18e0: 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 f {$doTestsWithR
18f0: 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 emoteServer == 1
1900: 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 65 6e } {. proc sen
1910: 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 dCommand {c} {..
1920: 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f global commandSo
1930: 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 cket...if {[eof
1940: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d $commandSocket]}
1950: 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 {.. error "r
1960: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 emote server dis
1970: 61 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a 09 69 appeared"..}...i
1980: 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 f {[catch {puts
1990: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 24 $commandSocket $
19a0: 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 c} msg]} {..
19b0: 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 error "remote se
19c0: 72 76 65 72 20 64 69 73 61 70 70 61 65 72 65 64 rver disappaered
19d0: 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 20 7b : $msg"..}..if {
19e0: 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f [catch {puts $co
19f0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d 2d 4d mmandSocket "--M
1a00: 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d arker--Marker--M
1a10: 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 arker--"} msg]}
1a20: 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 {.. error "re
1a30: 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 mote server disa
1a40: 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 ppeared: $msg"..
1a50: 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 22 22 0a }...set resp "".
1a60: 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 .while {1} {..
1a70: 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 74 73 set line [gets
1a80: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
1a90: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
1aa0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 commandSocket]}
1ab0: 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 6d 6f 74 {...error "remot
1ac0: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 e server disappe
1ad0: 61 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 20 20 ared".. }..
1ae0: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f if {[string co
1af0: 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 2d 2d 4d mpare $line "--M
1b00: 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d arker--Marker--M
1b10: 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 arker--"] == 0}
1b20: 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 {...if {[string
1b30: 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 compare [lindex
1b40: 24 72 65 73 70 20 30 5d 20 65 72 72 6f 72 5d 20 $resp 0] error]
1b50: 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 65 72 == 0} {... er
1b60: 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 ror [lindex $res
1b70: 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a p 1]...} else {.
1b80: 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 .. return [li
1b90: 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 ndex $resp 1]...
1ba0: 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a }.. } else {.
1bb0: 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 24 6c ..append resp $l
1bc0: 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a ine "\n".. }.
1bd0: 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 73 74 .}. }.}..test
1be0: 20 74 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 67 20 tlsIO-1.1 {arg
1bf0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
1c00: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
1c10: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
1c20: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
1c30: 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d 73 67 ket -server} msg
1c40: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
1c50: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
1c60: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
1c70: 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e t -server comman
1c80: 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 d ?options? port
1c90: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
1ca0: 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.2 {arg parsing
1cb0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
1cc0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
1cd0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
1ce0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
1cf0: 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d 20 24 rver foo} msg] $
1d00: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
1d10: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
1d20: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
1d30: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
1d40: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
1d50: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 33 ..test tlsIO-1.3
1d60: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
1d70: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
1d80: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
1d90: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
1da0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 s::socket -myadd
1db0: 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b r} msg] $msg.} {
1dc0: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
1dd0: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
1de0: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
1df0: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
1e00: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 34 20 7b test tlsIO-1.4 {
1e10: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
1e20: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
1e30: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
1e40: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
1e50: 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 :socket -myaddr
1e60: 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 5d 20 127.0.0.1} msg]
1e70: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
1e80: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
1e90: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
1ea0: 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 ?options? host p
1eb0: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
1ec0: 49 4f 2d 31 2e 35 20 7b 61 72 67 20 70 61 72 73 IO-1.5 {arg pars
1ed0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
1ee0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
1ef0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
1f00: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
1f10: 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d -myport} msg] $m
1f20: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
1f30: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
1f40: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f "tls::socket ?o
1f50: 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 ptions? host por
1f60: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
1f70: 2d 31 2e 36 20 7b 61 72 67 20 70 61 72 73 69 6e -1.6 {arg parsin
1f80: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
1f90: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
1fa0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
1fb0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
1fc0: 79 70 6f 72 74 20 78 78 78 78 7d 20 6d 73 67 5d yport xxxx} msg]
1fd0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
1fe0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
1ff0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
2000: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
2010: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2020: 73 49 4f 2d 31 2e 37 20 7b 61 72 67 20 70 61 72 sIO-1.7 {arg par
2030: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2040: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2050: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2060: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2070: 20 2d 6d 79 70 6f 72 74 20 32 35 32 32 7d 20 6d -myport 2522} m
2080: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2090: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
20a0: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
20b0: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
20c0: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
20d0: 20 74 6c 73 49 4f 2d 31 2e 38 20 7b 61 72 67 20 tlsIO-1.8 {arg
20e0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
20f0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2100: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
2110: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2120: 6b 65 74 20 2d 66 72 6f 62 6f 7a 7d 20 6d 73 67 ket -froboz} msg
2130: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
2140: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
2150: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
2160: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
2170: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
2180: 6c 73 49 4f 2d 31 2e 39 20 7b 61 72 67 20 70 61 lsIO-1.9 {arg pa
2190: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
21a0: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
21b0: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
21c0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
21d0: 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 20 2d 6d t -server foo -m
21e0: 79 70 6f 72 74 20 32 35 32 31 20 33 33 33 33 7d yport 2521 3333}
21f0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
2200: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
2210: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
2220: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f ocket -server co
2230: 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 mmand ?options?
2240: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2250: 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67 20 70 61 sIO-1.10 {arg pa
2260: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2270: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2280: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2290: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
22a0: 74 20 68 6f 73 74 20 32 35 32 38 20 2d 6a 75 6e t host 2528 -jun
22b0: 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b k} msg] $msg.} {
22c0: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
22d0: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
22e0: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
22f0: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
2300: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 31 20 test tlsIO-1.11
2310: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2320: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2330: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2340: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2350: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2360: 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 30 20 2d callback 2520 -
2370: 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b -} msg] $msg.} {
2380: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2390: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
23a0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
23b0: 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 command ?options
23c0: 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 ? port"}}..test
23d0: 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 72 67 20 tlsIO-1.12 {arg
23e0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
23f0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2400: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
2410: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2420: 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f 72 74 7d ket foo badport}
2430: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
2440: 7b 65 78 70 65 63 74 65 64 20 69 6e 74 65 67 65 {expected intege
2450: 72 20 62 75 74 20 67 6f 74 20 22 62 61 64 70 6f r but got "badpo
2460: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2470: 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 O-2.1 {tcp conne
2480: 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 ction} {socket s
2490: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
24a0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
24b0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
24c0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
24d0: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
24e0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
24f0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
2500: 20 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 2000 "set x tim
2510: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 ed_out"]. }.
2520: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
2530: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
2540: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
2550: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
2560: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
2570: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
2580: 65 72 76 65 72 4b 65 79 20 32 38 32 38 20 5c 5d erverKey 2828 \]
2590: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
25a0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
25b0: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
25c0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
25d0: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
25e0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
25f0: 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 $file..}..puts r
2600: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
2610: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
2620: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 er..close $f..pu
2630: 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 ts $x. }.
2640: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2650: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
2660: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
2670: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
2680: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
2690: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
26a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
26b0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
26c0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
26d0: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
26e0: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
26f0: 31 20 32 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 1 2828} msg]} {.
2700: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 6d set x $m
2710: 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a sg. } else {.
2720: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
2730: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
2740: 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 close $msg.
2750: 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 }. lappend
2760: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
2770: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2780: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e t x.} {ready don
2790: 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 e {}}..if [info
27a0: 65 78 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 exists port] {.
27b0: 20 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 incr port.} e
27c0: 6c 73 65 20 7b 20 0a 20 20 20 20 73 65 74 20 70 lse { . set p
27d0: 6f 72 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b ort [expr 2048 +
27e0: 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 7d 0a 0a [pid]%1024].}..
27f0: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 32 20 7b test tlsIO-2.2 {
2800: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 tcp connection w
2810: 69 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 74 20 ith client port
2820: 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b specified} {sock
2830: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
2840: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
2850: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
2860: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
2870: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
2880: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
2890: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
28a0: 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 2000 "set x don
28b0: 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 e"]. }. pu
28c0: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
28d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
28e0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
28f0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
2900: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2910: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
2920: 4b 65 79 20 32 38 32 39 20 5c 5d 22 0a 20 20 20 Key 2829 \]".
2930: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
2940: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 accept {file ad
2950: 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 dr port} {.
2960: 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a global x.
2970: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
2980: 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 20 24 "[gets $file] $
2990: 70 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 port".
29a0: 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 close $file.
29b0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
29c0: 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 done..}..puts re
29d0: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
29e0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
29f0: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 r..close $f.
2a00: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
2a10: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
2a20: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
2a30: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
2a40: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
2a50: 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 $f x. global
2a60: 70 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 port. if {[ca
2a70: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2a80: 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 5c -myport $port \
2a90: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
2aa0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
2ab0: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
2ac0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
2ad0: 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 7d 20 73 27.0.0.1 2829} s
2ae0: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
2af0: 73 65 74 20 78 20 24 73 6f 63 6b 0a 09 63 61 74 set x $sock..cat
2b00: 63 68 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a ch {close [tls::
2b10: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
2b20: 20 32 38 32 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 2829]}. } el
2b30: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 se {. put
2b40: 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 s $sock hello..f
2b50: 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 lush $sock.
2b60: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
2b70: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
2b80: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
2b90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
2ba0: 20 20 73 65 74 20 78 0a 7d 20 5b 6c 69 73 74 20 set x.} [list
2bb0: 72 65 61 64 79 20 22 68 65 6c 6c 6f 20 24 70 6f ready "hello $po
2bc0: 72 74 22 5d 0a 0a 74 65 73 74 20 74 6c 73 49 4f rt"]..test tlsIO
2bd0: 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.3 {tcp connec
2be0: 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 tion with client
2bf0: 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 interface speci
2c00: 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 fied} {socket st
2c10: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
2c20: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
2c30: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
2c40: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
2c50: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
2c60: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
2c70: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
2c80: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 "set x done"].
2c90: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
2ca0: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
2cb0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
2cc0: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
2cd0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
2ce0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
2cf0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 ile $serverKey 2
2d00: 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 830 \]". puts
2d10: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
2d20: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
2d30: 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 rt} {.
2d40: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
2d50: 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 puts "[ge
2d60: 74 73 20 24 66 69 6c 65 5d 20 24 61 64 64 72 22 ts $file] $addr"
2d70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
2d80: 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 se $file.
2d90: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
2da0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
2db0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
2dc0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
2dd0: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
2de0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2df0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
2e00: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
2e10: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
2e20: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
2e30: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
2e40: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
2e50: 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 5c 0a ddr 127.0.0.1 \.
2e60: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
2e70: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
2e80: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
2e90: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
2ea0: 37 2e 30 2e 30 2e 31 20 32 38 33 30 7d 20 73 6f 7.0.0.1 2830} so
2eb0: 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 ck]} {. s
2ec0: 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d et x $sock. }
2ed0: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
2ee0: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
2ef0: 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 20 24 ..catch {flush $
2f00: 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 6c 61 sock}. la
2f10: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
2f20: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
2f30: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
2f40: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2f50: 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 6c x.} {ready {hel
2f60: 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a 0a lo 127.0.0.1}}..
2f70: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 34 20 7b test tlsIO-2.4 {
2f80: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 tcp connection w
2f90: 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 65 72 ith server inter
2fa0: 66 61 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 face specified}
2fb0: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
2fc0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
2fd0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
2fe0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
2ff0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
3000: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
3010: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
3020: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
3030: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 x done"]. }.
3040: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
3050: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
3060: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
3070: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
3080: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3090: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
30a0: 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 erverKey -myaddr
30b0: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
30c0: 20 32 38 33 31 20 5c 5d 22 0a 20 20 20 20 70 75 2831 \]". pu
30d0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
30e0: 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 cept {file addr
30f0: 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 port} {.
3100: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
3110: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b puts "[
3120: 67 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 20 gets $file]".
3130: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
3140: 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 file.
3150: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
3160: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
3170: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
3180: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
3190: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
31a0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
31b0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
31c0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
31d0: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
31e0: 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 gets $f x.
31f0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
3200: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
3210: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3220: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3230: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
3240: 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e tKey [info hostn
3250: 61 6d 65 5d 20 32 38 33 31 7d 20 73 6f 63 6b 5d ame] 2831} sock]
3260: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
3270: 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c x $sock. } el
3280: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 se {. put
3290: 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 s $sock hello..f
32a0: 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 lush $sock.
32b0: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
32c0: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
32d0: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
32e0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
32f0: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
3300: 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c hello}..test tl
3310: 73 49 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e sIO-2.5 {tcp con
3320: 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 nection with red
3330: 75 6e 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f undant server po
3340: 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 rt} {socket stdi
3350: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
3360: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
3370: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
3380: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
3390: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
33a0: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
33b0: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
33c0: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 set x done"].
33d0: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
33e0: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
33f0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
3400: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
3410: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
3420: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
3430: 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 e $serverKey 283
3440: 32 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 2 \]". puts $
3450: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
3460: 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 {file addr port
3470: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
3480: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
3490: 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 puts "[gets
34a0: 20 24 66 69 6c 65 5d 22 0a 20 20 20 20 20 20 20 $file]".
34b0: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 close $file
34c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
34d0: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
34e0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
34f0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
3500: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
3510: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3520: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
3530: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3540: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3550: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
3560: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
3570: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
3580: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
3590: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
35a0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
35b0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
35c0: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 32 7d 127.0.0.1 2832}
35d0: 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 sock]} {.
35e0: 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 set x $sock.
35f0: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
3600: 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 puts $sock he
3610: 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b llo..flush $sock
3620: 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 . lappend
3630: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
3640: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
3650: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
3660: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
3670: 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 {ready hello}.te
3680: 73 74 20 74 6c 73 49 4f 2d 32 2e 36 20 7b 74 63 st tlsIO-2.6 {tc
3690: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 p connection} {s
36a0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
36b0: 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 status ok. i
36c0: 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 f {![catch {set
36d0: 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 sock [tls::socke
36e0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 33 t 127.0.0.1 2833
36f0: 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 ]}]} {..if {![ca
3700: 74 63 68 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d tch {gets $sock}
3710: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 ]} {.. set st
3720: 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 atus broken..}..
3730: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3740: 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 }. set status
3750: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 .} ok..test tlsI
3760: 4f 2d 32 2e 37 20 7b 65 63 68 6f 20 73 65 72 76 O-2.7 {echo serv
3770: 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 er, one line} {s
3780: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
3790: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
37a0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
37b0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
37c0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
37d0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
37e0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
37f0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
3800: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
3810: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3820: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3830: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
3840: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3850: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3860: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
3870: 76 65 72 4b 65 79 20 32 38 33 34 20 5c 5d 22 0a verKey 2834 \]".
3880: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3890: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
38a0: 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 p} {.
38b0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
38c0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
38d0: 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 o $s].. fconf
38e0: 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c igure $s -transl
38f0: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
3900: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 ing line.
3910: 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 }..proc echo {s
3920: 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 20 6c 20 } {.. set l
3930: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
3940: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
3950: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
3960: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
3970: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3980: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
3990: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
39a0: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
39b0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
39d0: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
39e0: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 }..}..puts
39f0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
3a00: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
3a10: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 imer..close $f..
3a20: 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 20 7d 0a puts done. }.
3a30: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3a40: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
3a50: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
3a60: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
3a70: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
3a80: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
3a90: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
3aa0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3ab0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3ac0: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
3ad0: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 tKey 127.0.0.1 2
3ae0: 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 834]. fconfig
3af0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
3b00: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
3b10: 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 74 73 20 ion lf. puts
3b20: 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 $s "hello abcdef
3b30: 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 ghijklmnop".
3b40: 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 after 1000. s
3b50: 65 74 20 78 20 5b 67 65 74 73 20 24 73 5d 0a 20 et x [gets $s].
3b60: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
3b70: 73 65 74 20 79 20 5b 67 65 74 73 20 24 66 5d 0a set y [gets $f].
3b80: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3b90: 20 6c 69 73 74 20 24 78 20 24 79 0a 7d 20 7b 7b list $x $y.} {{
3ba0: 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a hello abcdefghij
3bb0: 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 klmnop} done}..t
3bc0: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 38 20 7b 65 est tlsIO-2.8 {e
3bd0: 63 68 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f 70 cho server, loop
3be0: 20 35 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 6c 50 times, singl
3bf0: 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 e connection} {s
3c00: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
3c10: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3c20: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3c30: 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b s $f {. .pack
3c40: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
3c50: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
3c60: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
3c70: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
3c80: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
3c90: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
3ca0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
3cb0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
3cc0: 32 38 33 35 20 5c 5d 22 0a 20 20 20 20 70 75 74 2835 \]". put
3cd0: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
3ce0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 ept {s a p} {.
3cf0: 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 fileev
3d00: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
3d10: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 [list echo $s].
3d20: 20 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 fconf
3d30: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
3d40: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 ing line.
3d50: 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 }..proc echo {s
3d60: 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c } {.. global
3d70: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
3d80: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
3d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
3da0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 {[eof $s]} {.
3db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c gl
3dc0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
3dd0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3de0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3df0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
3e00: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
3e10: 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e { .. in
3e20: 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 cr i.
3e30: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
3e40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a . }.
3e50: 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 75 74 .}..set i 0..put
3e60: 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d s ready..set tim
3e70: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 er [after 20000
3e80: 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 76 "set x done"]..v
3e90: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
3ea0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
3eb0: 73 65 20 24 66 0a 09 70 75 74 73 20 22 64 6f 6e se $f..puts "don
3ec0: 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 20 20 e $i". }.
3ed0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3ee0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
3ef0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
3f00: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
3f10: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
3f20: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
3f30: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
3f40: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3f50: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
3f60: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
3f70: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 35 5d 127.0.0.1 2835]
3f80: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
3f90: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
3fa0: 6e 65 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 ne. catch {..
3fb0: 66 6f 72 20 7b 73 65 74 20 78 20 30 7d 20 7b 24 for {set x 0} {$
3fc0: 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 78 7d x < 50} {incr x}
3fd0: 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 {.. puts $s
3fe0: 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 "hello abcdefghi
3ff0: 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 67 65 jklmnop".. ge
4000: 74 73 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 ts $s..}. }.
4010: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
4020: 63 61 74 63 68 20 7b 73 65 74 20 78 20 5b 67 65 catch {set x [ge
4030: 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 ts $f]}. clos
4040: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
4050: 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 74 {done 50}..test
4060: 20 74 6c 73 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b tlsIO-2.9 {sock
4070: 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f et conflict} {so
4080: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
4090: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
40a0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
40b0: 65 70 74 20 32 38 32 38 5d 0a 20 20 20 20 72 65 ept 2828]. re
40c0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
40d0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
40e0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
40f0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 ts -nonewline $f
4100: 20 7b 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 {package requir
4110: 65 20 74 6c 73 3b 20 74 6c 73 3a 3a 73 6f 63 6b e tls; tls::sock
4120: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4130: 74 20 32 38 32 38 7d 0a 20 20 20 20 63 6c 6f 73 t 2828}. clos
4140: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
4150: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
4160: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
4170: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
4180: 20 67 65 74 73 20 24 66 0a 20 20 20 20 61 66 74 gets $f. aft
4190: 65 72 20 31 30 30 0a 20 20 20 20 73 65 74 20 78 er 100. set x
41a0: 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 63 [list [catch {c
41b0: 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d 20 24 6d lose $f} msg] $m
41c0: 73 67 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 sg]. close $s
41d0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 . set x.} {1
41e0: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
41f0: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
4200: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 0a 20 20 lready in use.
4210: 20 20 77 68 69 6c 65 20 65 78 65 63 75 74 69 6e while executin
4220: 67 0a 22 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 g."::socket -ser
4230: 76 65 72 20 7b 74 6c 73 3a 3a 5f 61 63 63 65 70 ver {tls::_accep
4240: 74 20 7b 2d 73 65 72 76 65 72 20 31 7d 20 61 63 t {-server 1} ac
4250: 63 65 70 74 7d 20 32 38 32 38 22 0a 20 20 20 20 cept} 2828".
4260: 28 22 65 76 61 6c 22 20 62 6f 64 79 20 6c 69 6e ("eval" body lin
4270: 65 20 31 29 0a 20 20 20 20 69 6e 76 6f 6b 65 64 e 1). invoked
4280: 20 66 72 6f 6d 20 77 69 74 68 69 6e 0a 22 65 76 from within."ev
4290: 61 6c 20 3a 3a 73 6f 63 6b 65 74 20 24 73 6f 70 al ::socket $sop
42a0: 74 73 22 0a 20 20 20 20 28 70 72 6f 63 65 64 75 ts". (procedu
42b0: 72 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 22 re "tls::socket"
42c0: 20 6c 69 6e 65 20 36 32 29 0a 20 20 20 20 69 6e line 62). in
42d0: 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 68 69 voked from withi
42e0: 6e 0a 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d n."tls::socket -
42f0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
4300: 32 38 22 0a 20 20 20 20 28 66 69 6c 65 20 22 73 28". (file "s
4310: 63 72 69 70 74 22 20 6c 69 6e 65 20 31 29 7d 7d cript" line 1)}}
4320: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 ..test tlsIO-2.1
4330: 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 63 65 0 {close on acce
4340: 70 74 2c 20 61 63 63 65 70 74 65 64 20 73 6f 63 pt, accepted soc
4350: 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73 6f 63 6b ket lives} {sock
4360: 65 74 20 6b 6e 6f 77 6e 42 75 67 7d 20 7b 0a 20 et knownBug} {.
4370: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
4380: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
4390: 65 72 20 32 30 30 30 30 20 22 73 65 74 20 64 6f er 20000 "set do
43a0: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 ne timed_out"].
43b0: 20 20 20 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a set ss [tls::
43c0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
43d0: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
43e0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
43f0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
4400: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
4410: 65 79 20 32 38 33 30 5d 0a 20 20 20 20 70 72 6f ey 2830]. pro
4420: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
4430: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 {..global ss..c
4440: 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 65 76 lose $ss..fileev
4450: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
4460: 22 72 65 61 64 69 74 20 24 73 22 0a 09 66 63 6f "readit $s"..fco
4470: 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e nfigure $s -tran
4480: 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 s lf. }. p
4490: 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b roc readit {s} {
44a0: 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 ..global done..g
44b0: 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 ets $s..close $s
44c0: 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 ..set done 1.
44d0: 20 7d 0a 20 20 20 20 73 65 74 20 63 73 20 5b 74 }. set cs [t
44e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
44f0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
4500: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4510: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
4520: 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f ientKey [info ho
4530: 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d 0a 20 20 stname] 2830].
4540: 20 20 63 6c 6f 73 65 20 24 63 73 0a 0a 20 20 20 close $cs..
4550: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
4560: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
4570: 6d 65 72 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 mer. set done
4580: 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f .} 1..test tlsIO
4590: 2d 32 2e 31 31 20 7b 64 65 74 65 63 74 69 6e 67 -2.11 {detecting
45a0: 20 6e 65 77 20 64 61 74 61 7d 20 7b 73 6f 63 6b new data} {sock
45b0: 65 74 20 6b 6e 6f 77 6e 42 75 67 7d 20 7b 0a 20 et knownBug} {.
45c0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
45d0: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
45e0: 20 73 6f 63 6b 0a 09 73 65 74 20 73 6f 63 6b 20 sock..set sock
45f0: 24 73 0a 09 73 65 74 20 66 20 5b 6f 70 65 6e 20 $s..set f [open
4600: 61 77 62 2e 6c 6f 67 20 77 5d 0a 09 70 75 74 73 awb.log w]..puts
4610: 20 24 66 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a $f [catch {tls:
4620: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 6f 63 6b :handshake $sock
4630: 7d 20 65 72 72 5d 0a 09 70 75 74 73 20 24 66 20 } err]..puts $f
4640: 22 65 72 72 3a 20 24 65 72 72 22 0a 09 70 75 74 "err: $err"..put
4650: 73 20 24 66 20 22 5b 74 6c 73 3a 3a 73 74 61 74 s $f "[tls::stat
4660: 75 73 20 24 73 6f 63 6b 5d 22 0a 09 63 6c 6f 73 us $sock]"..clos
4670: 65 20 24 73 0a 20 20 20 20 7d 0a 0a 20 20 20 20 e $s. }..
4680: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
4690: 65 74 20 2d 72 65 71 75 69 72 65 20 30 20 2d 72 et -require 0 -r
46a0: 65 71 75 65 73 74 20 30 20 2d 73 65 72 76 65 72 equest 0 -server
46b0: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
46c0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
46d0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
46e0: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
46f0: 72 4b 65 79 20 32 34 30 30 5d 0a 20 20 20 20 73 rKey 2400]. s
4700: 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 et sock "". s
4710: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
4720: 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c et -certfile $cl
4730: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
4740: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
4750: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
4760: 31 32 37 2e 30 2e 30 2e 31 20 32 34 30 30 5d 0a 127.0.0.1 2400].
4770: 20 20 20 20 76 77 61 69 74 20 73 6f 63 6b 0a 20 vwait sock.
4780: 20 20 20 70 75 74 73 20 24 73 32 20 6f 6e 65 0a puts $s2 one.
4790: 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 flush $s2.
47a0: 20 20 61 66 74 65 72 20 35 30 30 0a 20 20 20 20 after 500.
47b0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
47c0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 -blocking 0.
47d0: 20 73 65 74 20 72 65 73 75 6c 74 20 5b 67 65 74 set result [get
47e0: 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 s $sock]. lap
47f0: 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 67 65 74 pend result [get
4800: 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f s $sock]. fco
4810: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 nfigure $sock -b
4820: 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 70 75 locking 1. pu
4830: 74 73 20 24 73 32 20 74 77 6f 0a 20 20 20 20 66 ts $s2 two. f
4840: 6c 75 73 68 20 24 73 32 0a 20 20 20 20 66 63 6f lush $s2. fco
4850: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 nfigure $sock -b
4860: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 6c 61 locking 0. la
4870: 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 67 65 ppend result [ge
4880: 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 ts $sock]. fc
4890: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
48a0: 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 blocking 1. c
48b0: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
48c0: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
48d0: 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 65 $sock. set re
48e0: 73 75 6c 74 0a 7d 20 7b 6f 6e 65 20 7b 7d 20 74 sult.} {one {} t
48f0: 77 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d wo}..test tlsIO-
4900: 32 2e 31 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 2.12 {tcp connec
4910: 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 66 69 tion; no certifi
4920: 63 61 74 65 73 20 73 70 65 63 69 66 69 65 64 7d cates specified}
4930: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 {socket stdio p
4940: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 cCrash} {. re
4950: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
4960: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
4970: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
4980: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
4990: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
49a0: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
49b0: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 74 er 2000 "set x t
49c0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 imed_out"]..set
49d0: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
49e0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
49f0: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
4a00: 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 {file addr port
4a10: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
4a20: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
4a30: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c e. cl
4a40: 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 ose $file..}..pu
4a50: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
4a60: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
4a70: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
4a80: 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a ..puts $x. }.
4a90: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
4aa0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
4ab0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
4ac0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
4ad0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
4ae0: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
4af0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 h {tls::socket 1
4b00: 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 27.0.0.1 2828} m
4b10: 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 sg]} {. s
4b20: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
4b30: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c else {. l
4b40: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
4b50: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
4b60: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
4b70: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
4b80: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
4b90: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
4ba0: 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 ady done {}}..te
4bb0: 73 74 20 74 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f st tlsIO-3.1 {so
4bc0: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b cket conflict} {
4bd0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
4be0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
4bf0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
4c00: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
4c10: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
4c20: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
4c30: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
4c40: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
4c50: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
4c60: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
4c70: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
4c80: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4c90: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
4ca0: 76 65 72 4b 65 79 20 32 38 32 38 20 5c 5d 22 0a verKey 2828 \]".
4cb0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
4cc0: 75 74 73 20 72 65 61 64 79 0a 09 67 65 74 73 20 uts ready..gets
4cd0: 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a stdin..close $f.
4ce0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
4cf0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
4d00: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
4d10: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
4d20: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
4d30: 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 gets $f. set
4d40: 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b x [list [catch {
4d50: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
4d60: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
4d70: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
4d80: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
4d90: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
4da0: 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 .-server acce
4db0: 70 74 20 32 38 32 38 7d 20 6d 73 67 5d 20 5c 0a pt 2828} msg] \.
4dc0: 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 75 74 73 ..$msg]. puts
4dd0: 20 24 66 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 $f bye. clos
4de0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
4df0: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
4e00: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
4e10: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
4e20: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
4e30: 33 2e 32 20 7b 73 65 72 76 65 72 20 77 69 74 68 3.2 {server with
4e40: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
4e50: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
4e60: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
4e70: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
4e80: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
4e90: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
4ea0: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
4eb0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
4ec0: 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 1 [after 30000 "
4ed0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
4ee0: 5d 0a 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 ]..set t2 [after
4ef0: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
4f00: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 med_out"]..set t
4f10: 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 3 [after 32000 "
4f20: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
4f30: 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 ]..set counter 0
4f40: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
4f50: 24 66 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a $f "set s \[tls:
4f60: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4f70: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
4f80: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
4f90: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
4fa0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
4fb0: 20 32 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 2828 \]". pu
4fc0: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
4fd0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
4fe0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
4ff0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
5000: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
5010: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
5020: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 fering line..}..
5030: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
5040: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 . global x.
5050: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
5060: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
5070: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
5080: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
5090: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
50a0: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
50b0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
50c0: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
50d0: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 se {.
50e0: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
50f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a . }.
5100: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
5110: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
5120: 61 6e 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 ancel $t1..vwait
5130: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
5140: 20 24 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 $t2..vwait x..a
5150: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a fter cancel $t3.
5160: 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 .close $s..puts
5170: 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $x. }. clo
5180: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
5190: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
51a0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
51b0: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
51c0: 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 set x [gets $
51d0: 66 5d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 f]. set s1 [t
51e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
51f0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
5200: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
5210: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5220: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
5230: 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 127.0.0.1 282
5240: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
5250: 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 e $s1 -buffering
5260: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 line. set s2
5270: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
5280: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
5290: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
52a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
52b0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
52c0: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
52d0: 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2828]. fconfi
52e0: 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 gure $s2 -buffer
52f0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
5300: 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s3 [tls::socket
5310: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
5320: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
5330: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
5340: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
5350: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
5360: 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 2828]. fco
5370: 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 nfigure $s3 -buf
5380: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5390: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
53a0: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
53b0: 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 } {..puts $s1 he
53c0: 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 llo,s1..gets $s1
53d0: 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f ..puts $s2 hello
53e0: 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 ,s2..gets $s2..p
53f0: 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 uts $s3 hello,s3
5400: 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d ..gets $s3. }
5410: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
5420: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
5430: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 6c close $s3. l
5440: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
5450: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
5460: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
5470: 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 dy done}..test t
5480: 6c 73 49 4f 2d 34 2e 31 20 7b 73 65 72 76 65 72 lsIO-4.1 {server
5490: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
54a0: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
54b0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
54c0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
54d0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
54e0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
54f0: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
5500: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
5510: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
5520: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
5530: 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s \[tls::socke
5540: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
5550: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
5560: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5570: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
5580: 30 2e 30 2e 31 20 32 38 32 38 20 5c 5d 22 0a 20 0.0.1 2828 \]".
5590: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 puts $f {..fc
55a0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
55b0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 fering line..for
55c0: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
55d0: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
55e0: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 .. puts $s he
55f0: 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 llo.. gets $s
5600: 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 ..}..close $s..p
5610: 75 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 uts bye..gets st
5620: 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c din. }. cl
5630: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 ose $f. set p
5640: 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 1 [open "|[list
5650: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
5660: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
5670: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5680: 24 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $p1 -buffering l
5690: 69 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b ine. set p2 [
56a0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
56b0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
56c0: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
56d0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 fconfigure $p2
56e0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
56f0: 0a 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 . set p3 [ope
5700: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
5710: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
5720: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 ript]" r+]. f
5730: 63 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 configure $p3 -b
5740: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
5750: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
5760: 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 a p} {..fconfig
5770: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
5780: 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e g line..fileeven
5790: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
57a0: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
57b0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f }. proc echo
57c0: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 {s} {..global x
57d0: 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b . set l [
57e0: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 gets $s].
57f0: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
5800: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
5810: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
5820: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
5830: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 } else {.
5840: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
5850: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 s $l. }.
5860: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 }. set t1
5870: 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 [after 30000 "se
5880: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
5890: 20 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 set t2 [afte
58a0: 72 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 r 31000 "set x t
58b0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
58c0: 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 et t3 [after 320
58d0: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
58e0: 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 out"]. set s
58f0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
5900: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
5910: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
5920: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5930: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
5940: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
5950: 65 70 74 20 32 38 32 38 5d 0a 20 20 20 20 70 75 ept 2828]. pu
5960: 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 ts $p1 open.
5970: 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 puts $p2 open.
5980: 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e 0a puts $p3 open.
5990: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
59a0: 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 vwait x. vwai
59b0: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
59c0: 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 74 ncel $t1. aft
59d0: 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 er cancel $t2.
59e0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
59f0: 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a t3. close $s.
5a00: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
5a10: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 lappend l [list
5a20: 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 24 p1 [gets $p1] $
5a30: 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c x]. lappend l
5a40: 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 20 [list p2 [gets
5a50: 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 $p2] $x]. lap
5a60: 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 pend l [list p3
5a70: 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 [gets $p3] $x].
5a80: 20 20 20 70 75 74 73 20 24 70 31 20 62 79 65 0a puts $p1 bye.
5a90: 20 20 20 20 70 75 74 73 20 24 70 32 20 62 79 65 puts $p2 bye
5aa0: 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 62 79 . puts $p3 by
5ab0: 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 0a e. close $p1.
5ac0: 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 close $p2.
5ad0: 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 close $p3.
5ae0: 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 set l.} {{p1 bye
5af0: 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 done} {p2 bye d
5b00: 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e one} {p3 bye don
5b10: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
5b20: 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 4.2 {byte order
5b30: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
5b40: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
5b50: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
5b60: 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 set x ok. if
5b70: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
5b80: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
5b90: 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 o 0x3000} msg]}
5ba0: 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 {..set x $msg.
5bb0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 } else {..clos
5bc0: 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 e $msg. }.
5bd0: 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 set x.} ok..tes
5be0: 74 20 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 74 t tlsIO-5.1 {byt
5bf0: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
5c00: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
5c10: 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 , htons} \..{soc
5c20: 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 ket unixOnly not
5c30: 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 Root} {. set
5c40: 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e x {couldn't open
5c50: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
5c60: 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 er}. if {![ca
5c70: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
5c80: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 -server dodo 0x
5c90: 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 1} msg]} {.
5ca0: 20 20 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 set x {htons
5cb0: 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 problem, should
5cc0: 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 be disallowed, a
5cd0: 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 re you running a
5ce0: 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d s SU?}..close $m
5cf0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
5d00: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
5d10: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
5d20: 6f 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 owner}.test tlsI
5d30: 4f 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 O-5.2 {byte orde
5d40: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
5d50: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
5d60: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
5d70: 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 set x {couldn'
5d80: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
5d90: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
5da0: 69 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 igh}. if {![c
5db0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
5dc0: 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 t -server dodo 0
5dd0: 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a x10000} msg]} {.
5de0: 09 73 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 .set x {port res
5df0: 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c olution problem,
5e00: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
5e10: 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d lowed}..close $m
5e20: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
5e30: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
5e40: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 pen socket: port
5e50: 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 number too high
5e60: 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 33 }.test tlsIO-5.3
5e70: 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f {byte order pro
5e80: 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 blems, socket nu
5e90: 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a mbers, htons} \.
5ea0: 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c .{socket unixOnl
5eb0: 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 y notRoot} {.
5ec0: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 set x {couldn't
5ed0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
5ee0: 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 t owner}. if
5ef0: 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {![catch {tls::s
5f00: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
5f10: 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 do 21} msg]} {..
5f20: 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f set x {htons pro
5f30: 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 blem, should be
5f40: 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 disallowed, are
5f50: 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 you running as S
5f60: 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a U?}..close $msg.
5f70: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a }. set x.
5f80: 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e } {couldn't open
5f90: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
5fa0: 65 72 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d er}..test tlsIO-
5fb0: 36 2e 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 6.1 {accept call
5fc0: 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 75 6e 65 back error} {une
5fd0: 78 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 xplainedFailure
5fe0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 socket stdio pcC
5ff0: 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rash} {. remo
6000: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
6010: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
6020: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
6030: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
6040: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
6050: 67 65 74 73 20 73 74 64 69 6e 0a 09 74 6c 73 3a gets stdin..tls:
6060: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
6070: 31 20 32 38 34 38 0a 20 20 20 20 7d 0a 20 20 20 1 2848. }.
6080: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6090: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
60a0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
60b0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
60c0: 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 +]. proc bger
60d0: 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 ror args {..glob
60e0: 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 al x..set x $arg
60f0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 s. }. proc
6100: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
6110: 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 {expr 10 / 0}.
6120: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6130: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
6140: 65 70 74 20 32 38 34 38 5d 0a 20 20 20 20 70 75 ept 2848]. pu
6150: 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 ts $f hello.
6160: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6170: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
6180: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
6190: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
61a0: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
61b0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
61c0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 lose $s. rena
61d0: 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 me bgerror {}.
61e0: 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 set x.} {{divi
61f0: 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 23 20 de by zero}}..#
6200: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
6210: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
6220: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
6230: 20 66 6f 72 20 27 2d 70 65 65 72 6e 61 6d 65 27 for '-peername'
6240: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 31 ..test tlsIO-7.1
6250: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
6260: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
6270: 73 7d 20 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 s} {knownBug soc
6280: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
6290: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
62a0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
62b0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
62c0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
62d0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
62e0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
62f0: 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f "tls::socket -
6300: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
6310: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
6320: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
6330: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
6340: 72 76 65 72 4b 65 79 20 32 38 32 30 22 0a 20 20 rverKey 2820".
6350: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
6360: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
6370: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
6380: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
6390: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
63a0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
63b0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
63c0: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
63d0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
63e0: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
63f0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6400: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
6410: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
6420: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
6430: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
6440: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6450: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
6460: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
6470: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6480: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
6490: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
64a0: 30 2e 30 2e 31 20 32 38 32 30 5d 0a 20 20 20 20 0.0.1 2820].
64b0: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
64c0: 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a e $s -peername].
64d0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
64e0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
64f0: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
6500: 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d nd l [string com
6510: 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 pare [lindex $p
6520: 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 0] 127.0.0.1].
6530: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 lappend l [str
6540: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e ing compare [lin
6550: 64 65 78 20 24 70 20 32 5d 20 32 38 32 30 5d 0a dex $p 2] 2820].
6560: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
6570: 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 20 length $p].} {0
6580: 30 20 33 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f 0 3}..# bug repo
6590: 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 rt #5812 fconfig
65a0: 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 ure doesn't retu
65b0: 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 rn value for '-s
65c0: 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 ockname'..test t
65d0: 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 73 74 69 6e lsIO-7.2 {testin
65e0: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
65f0: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 c options} {know
6600: 6e 42 75 67 20 73 6f 63 6b 65 74 20 73 74 64 69 nBug socket stdi
6610: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
6620: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
6630: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
6640: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
6650: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
6660: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
6670: 20 20 70 75 74 73 20 24 66 20 22 74 6c 73 3a 3a puts $f "tls::
6680: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6690: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
66a0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
66b0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
66c0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
66d0: 32 38 32 31 22 0a 20 20 20 20 70 75 74 73 20 24 2821". puts $
66e0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
66f0: 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f args {.. glo
6700: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
6710: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
6720: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
6730: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
6740: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
6750: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
6760: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6770: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
6780: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
6790: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
67a0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
67b0: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
67c0: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
67d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
67e0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
67f0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
6800: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6810: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
6820: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 127.0.0.1 28
6830: 32 31 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 21]. set p [f
6840: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
6850: 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ckname]. clos
6860: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
6870: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
6880: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c lappend l [ll
6890: 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 ength $p]. la
68a0: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
68b0: 24 70 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e $p 0]. lappen
68c0: 64 20 6c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 d l [string equa
68d0: 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 l [lindex $p 2]
68e0: 32 38 32 31 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2821].} {3 127.0
68f0: 2e 30 2e 31 20 30 7d 0a 0a 74 65 73 74 20 74 6c .0.1 0}..test tl
6900: 73 49 4f 2d 37 2e 33 20 7b 74 65 73 74 69 6e 67 sIO-7.3 {testing
6910: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
6920: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
6930: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b t} {. set s [
6940: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
6950: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
6960: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6970: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6980: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
6990: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
69a0: 38 32 32 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 822]. set l [
69b0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 5d 0a 20 fconfigure $s].
69c0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
69d0: 75 70 64 61 74 65 0a 20 20 20 20 6c 6c 65 6e 67 update. lleng
69e0: 74 68 20 24 6c 0a 7d 20 31 32 0a 0a 23 20 62 75 th $l.} 12..# bu
69f0: 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 g report #5812 f
6a00: 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 configure doesn'
6a10: 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 t return value f
6a20: 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a or '-sockname'..
6a30: 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 34 20 7b test tlsIO-7.4 {
6a40: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
6a50: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
6a60: 20 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 {knownBug socke
6a70: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b t} {. set s [
6a80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
6a90: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
6aa0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6ab0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6ac0: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
6ad0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
6ae0: 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 823]. proc ac
6af0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
6b00: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
6b10: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
6b20: 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 sockname]..close
6b30: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
6b40: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
6b50: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
6b60: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
6b70: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6b80: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
6b90: 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 . .[info host
6ba0: 6e 61 6d 65 5d 20 32 38 32 33 5d 0a 20 20 20 20 name] 2823].
6bb0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6bc0: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6bd0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6be0: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6bf0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6c00: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
6c10: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
6c20: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
6c30: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 d l [lindex $x 2
6c40: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d ] [llength $x].}
6c50: 20 7b 32 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 {2823 3}..# bug
6c60: 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 report #5812 fc
6c70: 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 onfigure doesn't
6c80: 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f return value fo
6c90: 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 r '-sockname'..t
6ca0: 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 est tlsIO-7.5 {t
6cb0: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
6cc0: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
6cd0: 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 {knownBug socket
6ce0: 20 75 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 20 unixOrPc} {.
6cf0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6d00: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
6d10: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
6d20: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
6d30: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
6d40: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
6d50: 61 63 63 65 70 74 20 32 38 32 39 5d 0a 20 20 20 accept 2829].
6d60: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
6d70: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 a p} {..global x
6d80: 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 ..set x [fconfig
6d90: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 ure $s -sockname
6da0: 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 ]..close $s.
6db0: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
6dc0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
6dd0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
6de0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6df0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
6e00: 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 31 32 entKey \. .12
6e10: 37 2e 30 2e 30 2e 31 20 32 38 32 39 5d 0a 20 20 7.0.0.1 2829].
6e20: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
6e30: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
6e40: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
6e50: 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 vwait x. afte
6e60: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
6e70: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
6e80: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 close $s1. s
6e90: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
6ea0: 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 end l [lindex $x
6eb0: 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 0] [lindex $x 2
6ec0: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d ] [llength $x].}
6ed0: 20 7b 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 {127.0.0.1 2829
6ee0: 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 3}..test tlsIO-
6ef0: 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 8.1 {testing -as
6f00: 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b ync flag on sock
6f10: 65 74 73 7d 20 7b 65 6d 70 74 79 20 73 6f 63 6b ets} {empty sock
6f20: 65 74 7d 20 7b 0a 20 20 20 20 23 20 74 65 73 74 et} {. # test
6f30: 20 73 65 65 6d 73 20 74 6f 20 68 61 6e 67 20 2d seems to hang -
6f40: 2d 20 61 77 62 20 36 2f 32 2f 32 30 30 30 0a 20 - awb 6/2/2000.
6f50: 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 73 20 # NOTE: This
6f60: 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 6f 6e test may fail on
6f70: 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 32 2e some Solaris 2.
6f80: 34 20 73 79 73 74 65 6d 73 2e 20 49 66 20 69 74 4 systems. If it
6f90: 20 64 6f 65 73 2c 0a 20 20 20 20 23 20 63 68 65 does,. # che
6fa0: 63 6b 20 74 68 61 74 20 79 6f 75 20 68 61 76 65 ck that you have
6fb0: 20 74 68 65 73 65 20 70 61 74 63 68 65 73 20 69 these patches i
6fc0: 6e 73 74 61 6c 6c 65 64 20 28 75 73 69 6e 67 20 nstalled (using
6fd0: 73 68 6f 77 72 65 76 20 2d 70 29 3a 0a 20 20 20 showrev -p):.
6fe0: 20 23 0a 20 20 20 20 23 20 31 30 31 39 30 37 2d #. # 101907-
6ff0: 30 35 2c 20 31 30 31 39 32 35 2d 30 32 2c 20 31 05, 101925-02, 1
7000: 30 31 39 34 35 2d 31 34 2c 20 31 30 31 39 35 39 01945-14, 101959
7010: 2d 30 33 2c 20 31 30 31 39 36 39 2d 30 35 2c 20 -03, 101969-05,
7020: 31 30 31 39 37 33 2d 30 33 2c 0a 20 20 20 20 23 101973-03,. #
7030: 20 31 30 31 39 37 37 2d 30 33 2c 20 31 30 31 39 101977-03, 1019
7040: 38 31 2d 30 32 2c 20 31 30 31 39 38 35 2d 30 31 81-02, 101985-01
7050: 2c 20 31 30 32 30 30 31 2d 30 33 2c 20 31 30 32 , 102001-03, 102
7060: 30 30 33 2d 30 31 2c 20 31 30 32 30 30 37 2d 30 003-01, 102007-0
7070: 31 2c 0a 20 20 20 20 23 20 31 30 32 30 31 31 2d 1,. # 102011-
7080: 30 32 2c 20 31 30 32 30 32 34 2d 30 31 2c 20 31 02, 102024-01, 1
7090: 30 32 30 33 39 2d 30 31 2c 20 31 30 32 30 34 34 02039-01, 102044
70a0: 2d 30 31 2c 20 31 30 32 30 34 38 2d 30 31 2c 20 -01, 102048-01,
70b0: 31 30 32 30 36 32 2d 30 33 2c 0a 20 20 20 20 23 102062-03,. #
70c0: 20 31 30 32 30 36 36 2d 30 34 2c 20 31 30 32 30 102066-04, 1020
70d0: 37 30 2d 30 31 2c 20 31 30 32 31 30 35 2d 30 31 70-01, 102105-01
70e0: 2c 20 31 30 32 31 35 33 2d 30 33 2c 20 31 30 32 , 102153-03, 102
70f0: 32 31 36 2d 30 31 2c 20 31 30 32 32 33 32 2d 30 216-01, 102232-0
7100: 31 2c 0a 20 20 20 20 23 20 31 30 31 38 37 38 2d 1,. # 101878-
7110: 30 33 2c 20 31 30 31 38 37 39 2d 30 31 2c 20 31 03, 101879-01, 1
7120: 30 31 38 38 30 2d 30 33 2c 20 31 30 31 39 33 33 01880-03, 101933
7130: 2d 30 31 2c 20 31 30 31 39 35 30 2d 30 31 2c 20 -01, 101950-01,
7140: 31 30 32 30 33 30 2d 30 31 2c 0a 20 20 20 20 23 102030-01,. #
7150: 20 31 30 32 30 35 37 2d 30 38 2c 20 31 30 32 31 102057-08, 1021
7160: 34 30 2d 30 31 2c 20 31 30 31 39 32 30 2d 30 32 40-01, 101920-02
7170: 2c 20 31 30 31 39 32 31 2d 30 39 2c 20 31 30 31 , 101921-09, 101
7180: 39 32 32 2d 30 37 2c 20 31 30 31 39 32 33 2d 30 922-07, 101923-0
7190: 33 0a 20 20 20 20 23 0a 20 20 20 20 23 20 49 66 3. #. # If
71a0: 20 61 66 74 65 72 20 69 6e 73 74 61 6c 6c 69 6e after installin
71b0: 67 20 74 68 65 73 65 20 70 61 74 63 68 65 73 20 g these patches
71c0: 79 6f 75 20 61 72 65 20 73 74 69 6c 6c 20 65 78 you are still ex
71d0: 70 65 72 69 65 6e 63 69 6e 67 20 61 0a 20 20 20 periencing a.
71e0: 20 23 20 70 72 6f 62 6c 65 6d 2c 20 70 6c 65 61 # problem, plea
71f0: 73 65 20 65 6d 61 69 6c 20 6a 79 6c 40 65 6e 67 se email jyl@eng
7200: 2e 73 75 6e 2e 63 6f 6d 2e 20 57 65 20 68 61 76 .sun.com. We hav
7210: 65 20 6e 6f 74 20 6f 62 73 65 72 76 65 64 20 74 e not observed t
7220: 68 69 73 0a 20 20 20 20 23 20 66 61 69 6c 75 72 his. # failur
7230: 65 20 6f 6e 20 53 6f 6c 61 72 69 73 20 32 2e 35 e on Solaris 2.5
7240: 2c 20 73 6f 20 61 6e 6f 74 68 65 72 20 6f 70 74 , so another opt
7250: 69 6f 6e 20 28 69 6e 73 74 65 61 64 20 6f 66 20 ion (instead of
7260: 69 6e 73 74 61 6c 6c 69 6e 67 0a 20 20 20 20 23 installing. #
7270: 20 74 68 65 73 65 20 70 61 74 63 68 65 73 29 20 these patches)
7280: 69 73 20 74 6f 20 75 70 67 72 61 64 65 20 74 6f is to upgrade to
7290: 20 53 6f 6c 61 72 69 73 20 32 2e 35 2e 0a 20 20 Solaris 2.5..
72a0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
72b0: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
72c0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
72d0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
72e0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
72f0: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
7300: 20 61 63 63 65 70 74 20 32 38 33 30 5d 0a 20 20 accept 2830].
7310: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
7320: 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 a p} {..global
7330: 78 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 x..puts $s bye..
7340: 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 78 20 close $s..set x
7350: 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 done. }. s
7360: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
7370: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
7380: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
7390: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
73a0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
73b0: 5c 0a 09 2d 61 73 79 6e 63 20 5b 69 6e 66 6f 20 \..-async [info
73c0: 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d 0a hostname] 2830].
73d0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
73e0: 73 65 74 20 7a 20 5b 67 65 74 73 20 24 73 31 5d set z [gets $s1]
73f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
7400: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
7410: 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 65 73 set z.} bye..tes
7420: 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b 74 65 73 t tlsIO-9.1 {tes
7430: 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 76 ting spurious ev
7440: 65 6e 74 73 7d 20 7b 65 6d 70 74 79 20 73 6f 63 ents} {empty soc
7450: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 6c 6f 63 ket} {. # loc
7460: 6b 73 20 75 70 20 0a 20 20 20 20 73 65 74 20 6c ks up . set l
7470: 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 en 0. set spu
7480: 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 rious 0. set
7490: 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 done 0. proc
74a0: 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b readlittle {s} {
74b0: 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 ..global spuriou
74c0: 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 s done len..set
74d0: 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 l [read $s 1]..i
74e0: 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 f {[string lengt
74f0: 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 h $l] == 0} {..
7500: 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d if {![eof $s]
7510: 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 } {...incr spuri
7520: 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ous.. } else
7530: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 {...close $s...s
7540: 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d et done 1.. }
7550: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
7560: 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 incr len [string
7570: 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 length $l]..}.
7580: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 }. proc ac
7590: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
75a0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
75b0: 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 20 2d 62 uffering none -b
75c0: 6c 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 66 69 6c locking off..fil
75d0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
75e0: 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 le [list readlit
75f0: 74 6c 65 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 tle $s]. }.
7600: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
7610: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
7620: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
7630: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7640: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
7650: 79 20 5c 0a 20 20 20 09 2d 73 65 72 76 65 72 20 y \. .-server
7660: 61 63 63 65 70 74 20 32 38 33 31 5d 0a 20 20 20 accept 2831].
7670: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
7680: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
7690: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
76a0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
76b0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
76c0: 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f \. .[info ho
76d0: 73 74 6e 61 6d 65 5d 20 32 38 33 31 5d 0a 20 20 stname] 2831].
76e0: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
76f0: 65 20 24 63 20 30 31 32 33 34 35 36 37 38 39 30 e $c 01234567890
7700: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
7710: 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 7890123456789012
7720: 33 34 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 73 3456789. clos
7730: 65 20 24 63 0a 20 20 20 20 73 65 74 20 74 69 6d e $c. set tim
7740: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
7750: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
7760: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
7770: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
7780: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
7790: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 close $s. li
77a0: 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 st $spurious $le
77b0: 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 n.} {0 50}..test
77c0: 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 73 74 tlsIO-9.2 {test
77d0: 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c ing async write,
77e0: 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 fileevents, flu
77f0: 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f sh on close} {so
7800: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
7810: 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a 20 20 firstblock "".
7820: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
7830: 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 20 69 {$i < 5} {incr i
7840: 7d 20 7b 73 65 74 20 66 69 72 73 74 62 6c 6f 63 } {set firstbloc
7850: 6b 20 22 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 k "a$firstblock$
7860: 66 69 72 73 74 62 6c 6f 63 6b 22 7d 0a 20 20 20 firstblock"}.
7870: 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b set secondblock
7880: 20 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 "". for {set
7890: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d 20 i 0} {$i < 16}
78a0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 73 65 74 20 {incr i} {..set
78b0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 secondblock "b$s
78c0: 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e econdblock$secon
78d0: 64 62 6c 6f 63 6b 22 0a 20 20 20 20 7d 0a 70 75 dblock". }.pu
78e0: 74 73 20 22 66 69 72 73 74 62 6c 6f 63 6b 20 3d ts "firstblock =
78f0: 20 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 [string length
7900: 20 24 66 69 72 73 74 62 6c 6f 63 6b 5d 22 0a 70 $firstblock]".p
7910: 75 74 73 20 22 73 65 63 6f 6e 64 62 6c 6f 63 6b uts "secondblock
7920: 20 3d 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 = [string lengt
7930: 68 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 5d 22 h $secondblock]"
7940: 0a 20 20 20 20 73 65 74 20 6c 20 5b 74 6c 73 3a . set l [tls:
7950: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
7960: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
7970: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7980: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
7990: 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 rKey \. .-ser
79a0: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 32 5d ver accept 2832]
79b0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
79c0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
79d0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
79e0: 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 ing 0 -translati
79f0: 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a on lf -buffersiz
7a00: 65 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 e 16384 \...-buf
7a10: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c fering line..fil
7a20: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
7a30: 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 le "readable $s"
7a40: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
7a50: 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 readable {s} {..
7a60: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
7a70: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
7a80: 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 adable {}..after
7a90: 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 1000 respond $s
7aa0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
7ab0: 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 respond {s} {..g
7ac0: 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b lobal firstblock
7ad0: 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e ..puts -nonewlin
7ae0: 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b e $s $firstblock
7af0: 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 72 69 ..after 1000 wri
7b00: 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a tedata $s. }.
7b10: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 proc writeda
7b20: 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c ta {s} {..global
7b30: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 secondblock..pu
7b40: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
7b50: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 $secondblock..c
7b60: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
7b70: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
7b80: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
7b90: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
7ba0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7bb0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
7bc0: 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 y \. .[info h
7bd0: 6f 73 74 6e 61 6d 65 5d 20 32 38 33 32 5d 0a 20 ostname] 2832].
7be0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
7bf0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 -blocking 0 -tr
7c00: 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e ans lf -bufferin
7c10: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 g line. set c
7c20: 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 ount 0. puts
7c30: 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 70 72 6f $s hello. pro
7c40: 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 c readit {s} {..
7c50: 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e global count don
7c60: 65 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 e..set l [read $
7c70: 73 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b s]..incr count [
7c80: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
7c90: 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d ]..if {[eof $s]}
7ca0: 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 {.. close $s
7cb0: 0a 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 .. set done 1
7cc0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 66 69 ..}. }. fi
7cd0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
7ce0: 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a ble "readit $s".
7cf0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
7d00: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
7d10: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
7d20: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
7d30: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
7d40: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
7d50: 65 20 24 6c 0a 20 20 20 20 73 65 74 20 63 6f 75 e $l. set cou
7d60: 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 nt.} 65566..test
7d70: 20 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 65 73 74 tlsIO-9.3 {test
7d80: 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 ing EOF stickyne
7d90: 73 73 7d 20 7b 65 6d 70 74 79 20 73 6f 63 6b 65 ss} {empty socke
7da0: 74 7d 20 7b 0a 20 20 20 20 23 20 68 61 6e 67 73 t} {. # hangs
7db0: 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f . proc count_
7dc0: 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c to_eof {s} {..gl
7dd0: 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 20 obal count done
7de0: 74 69 6d 65 72 0a 09 73 65 74 20 6c 20 5b 67 65 timer..set l [ge
7df0: 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 ts $s]..if {[eof
7e00: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 $s]} {.. inc
7e10: 72 20 63 6f 75 6e 74 0a 09 20 20 20 20 69 66 20 r count.. if
7e20: 7b 24 63 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 {$count > 9} {..
7e30: 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 .close $s...set
7e40: 64 6f 6e 65 20 74 72 75 65 0a 09 09 73 65 74 20 done true...set
7e50: 63 6f 75 6e 74 20 7b 65 6f 66 20 69 73 20 73 74 count {eof is st
7e60: 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 icky}...after ca
7e70: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 20 20 20 ncel $timer..
7e80: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
7e90: 70 72 6f 63 20 74 69 6d 65 72 70 72 6f 63 20 7b proc timerproc {
7ea0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 } {..global done
7eb0: 20 63 6f 75 6e 74 20 63 0a 09 73 65 74 20 64 6f count c..set do
7ec0: 6e 65 20 74 72 75 65 0a 09 73 65 74 20 63 6f 75 ne true..set cou
7ed0: 6e 74 20 7b 74 69 6d 65 72 20 77 65 6e 74 20 6f nt {timer went o
7ee0: 66 66 2c 20 65 6f 66 20 69 73 20 6e 6f 74 20 73 ff, eof is not s
7ef0: 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 ticky}..close $c
7f00: 0a 20 20 20 20 7d 09 0a 20 20 20 20 73 65 74 20 . }.. set
7f10: 63 6f 75 6e 74 20 30 0a 20 20 20 20 73 65 74 20 count 0. set
7f20: 64 6f 6e 65 20 66 61 6c 73 65 0a 20 20 20 20 70 done false. p
7f30: 72 6f 63 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 roc write_then_c
7f40: 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 75 74 73 lose {s} {..puts
7f50: 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 $s bye..close $
7f60: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 s. }. proc
7f70: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
7f80: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
7f90: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
7fa0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
7fb0: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 ..fileevent $s w
7fc0: 72 69 74 61 62 6c 65 20 22 77 72 69 74 65 5f 74 ritable "write_t
7fd0: 68 65 6e 5f 63 6c 6f 73 65 20 24 73 22 0a 20 20 hen_close $s".
7fe0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
7ff0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
8000: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
8010: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
8020: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
8030: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d rverKey \. .-
8040: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
8050: 33 33 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 33]. set c [t
8060: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
8070: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
8080: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
8090: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
80a0: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 5b ientKey \. .[
80b0: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 info hostname] 2
80c0: 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 833]. fconfig
80d0: 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 ure $c -blocking
80e0: 20 6f 66 66 20 2d 62 75 66 66 65 72 69 6e 67 20 off -buffering
80f0: 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f line -translatio
8100: 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 65 n lf. fileeve
8110: 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 nt $c readable "
8120: 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 22 count_to_eof $c"
8130: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
8140: 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 72 after 1000 timer
8150: 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 20 proc]. vwait
8160: 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 done. close $
8170: 73 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a s. set count.
8180: 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 } {eof is sticky
8190: 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 }..removeFile sc
81a0: 72 69 70 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f ript..test tlsIO
81b0: 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 -10.1 {testing s
81c0: 6f 63 6b 65 74 20 61 63 63 65 70 74 20 63 61 6c ocket accept cal
81d0: 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 61 6e 64 lback error hand
81e0: 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b ling} {socket} {
81f0: 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f . set goterro
8200: 72 20 30 0a 20 20 20 20 70 72 6f 63 20 62 67 65 r 0. proc bge
8210: 72 72 6f 72 20 61 72 67 73 20 7b 67 6c 6f 62 61 rror args {globa
8220: 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 65 74 20 l goterror; set
8230: 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 20 20 20 goterror 1}.
8240: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
8250: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
8260: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
8270: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8280: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8290: 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 \. .-server a
82a0: 63 63 65 70 74 20 32 38 39 38 5d 0a 20 20 20 20 ccept 2898].
82b0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
82c0: 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 p} {close $s; e
82d0: 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 20 rror}. set c
82e0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
82f0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
8300: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
8310: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
8320: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 31 32 37 clientKey \..127
8330: 2e 30 2e 30 2e 31 20 32 38 39 38 5d 0a 20 20 20 .0.0.1 2898].
8340: 20 76 77 61 69 74 20 67 6f 74 65 72 72 6f 72 0a vwait goterror.
8350: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
8360: 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 close $c. se
8370: 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 31 0a 0a t goterror.} 1..
8380: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 20 test tlsIO-11.1
8390: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d {tcp connection}
83a0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
83b0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
83c0: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d } {. sendComm
83d0: 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 and "set caCert
83e0: 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e $caCert". sen
83f0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
8400: 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 rverCert $server
8410: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
8420: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
8430: 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 tCert $clientCer
8440: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
8450: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 nd "set serverKe
8460: 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 y $serverKey".
8470: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8480: 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c et clientKey $cl
8490: 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e ientKey". sen
84a0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
84b0: 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 socket9_1_test_s
84c0: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
84d0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
84e0: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
84f0: 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 $serverCert \...
8500: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
8510: 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 \...-keyfile $se
8520: 72 76 65 72 4b 65 79 20 5c 0a 09 09 32 38 33 34 rverKey \...2834
8530: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
8540: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 70 75 s a p} {.. pu
8550: 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 ts $s done..
8560: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
8570: 73 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a s.. close $s.
8580: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
8590: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
85a0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
85b0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
85c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
85d0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
85e0: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
85f0: 65 72 76 65 72 49 50 20 32 38 33 34 5d 0a 20 20 erverIP 2834].
8600: 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 set r [gets $s
8610: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
8620: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
8630: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 31 close $socket9_1
8640: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
8650: 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e 65 0a 0a set r.} done..
8660: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 32 20 test tlsIO-11.2
8670: 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 66 69 65 {client specifie
8680: 73 20 69 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 s its port} {soc
8690: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
86a0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
86b0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
86c0: 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 set caCert $caCe
86d0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
86e0: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 and "set serverC
86f0: 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 ert $serverCert"
8700: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8710: 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 "set clientCert
8720: 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 $clientCert".
8730: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8740: 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 et serverKey $se
8750: 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e rverKey". sen
8760: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
8770: 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b ientKey $clientK
8780: 65 79 22 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 ey". if {[inf
8790: 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 o exists port]}
87a0: 7b 0a 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 {..incr port.
87b0: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 } else {..set p
87c0: 6f 72 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b ort [expr 2048 +
87d0: 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 [pid]%1024].
87e0: 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }. sendComma
87f0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
8800: 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 9_2_test_server
8810: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
8820: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 rver accept \...
8830: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
8840: 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c rCert \...-cafil
8850: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b e $caCert \...-k
8860: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
8870: 79 20 5c 0a 09 20 20 20 20 32 38 33 35 5d 0a 09 y \.. 2835]..
8880: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
8890: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
88a0: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
88b0: 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 puts $s $p..
88c0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
88d0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
88e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
88f0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
8900: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8910: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8920: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8930: 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 -myport $port
8940: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
8950: 20 32 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 2835]. set r
8960: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
8970: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 lose $s. send
8980: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
8990: 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 socket9_2_test_s
89a0: 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 erver}. if {$
89b0: 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 r == $port} {..s
89c0: 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 et result ok.
89d0: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 } else {..set r
89e0: 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 esult broken.
89f0: 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c }. set resul
8a00: 74 0a 7d 20 6f 6b 0a 74 65 73 74 20 74 6c 73 49 t.} ok.test tlsI
8a10: 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 O-11.3 {trying t
8a20: 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 o connect, no se
8a30: 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f rver} {socket do
8a40: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8a50: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 erver} {. set
8a60: 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 status ok. i
8a70: 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 f {![catch {set
8a80: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
8a90: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8aa0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
8ab0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8ac0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
8ad0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
8ae0: 72 76 65 72 49 70 20 32 38 33 36 5d 7d 5d 7d 20 rverIp 2836]}]}
8af0: 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b {..if {![catch {
8b00: 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 gets $s}]} {..
8b10: 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f set status bro
8b20: 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 ken..}..close $s
8b30: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
8b40: 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 tatus.} ok..test
8b50: 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d tlsIO-11.4 {rem
8b60: 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 ote echo, one li
8b70: 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ne} {socket doTe
8b80: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
8b90: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
8ba0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 ommand "set caCe
8bb0: 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 rt $caCert".
8bc0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8bd0: 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 serverCert $ser
8be0: 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e verCert". sen
8bf0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
8c00: 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 ientCert $client
8c10: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
8c20: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
8c30: 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 rKey $serverKey"
8c40: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8c50: 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 "set clientKey
8c60: 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 $clientKey".
8c70: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 20 20 sendCommand {.
8c80: 20 20 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 .global server
8c90: 43 65 72 74 0a 09 67 6c 6f 62 61 6c 20 63 61 43 Cert..global caC
8ca0: 65 72 74 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 ert..global serv
8cb0: 65 72 4b 65 79 0a 09 73 65 74 20 73 6f 63 6b 65 erKey..set socke
8cc0: 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 t10_6_test_serve
8cd0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
8ce0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
8cf0: 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 rverCert \...-ca
8d00: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
8d10: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
8d20: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
8d30: 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 accept 2836]..p
8d40: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
8d50: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
8d60: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
8d70: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
8d80: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
8d90: 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 o $s].. fconf
8da0: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
8db0: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
8dc0: 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 ation crlf..}..p
8dd0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
8de0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
8df0: 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f $s].. if {[eo
8e00: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
8e10: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 $s.. } else
8e20: 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 {...puts $s $l..
8e30: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
8e40: 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 set f [tls::s
8e50: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8e60: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
8e70: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8e80: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
8e90: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
8ea0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 emoteServerIP 28
8eb0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
8ec0: 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 re $f -translati
8ed0: 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 on crlf -bufferi
8ee0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 ng line. puts
8ef0: 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 $f hello. se
8f00: 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t r [gets $f].
8f10: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
8f20: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
8f30: 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 e $socket10_6_te
8f40: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
8f50: 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 et r.} hello..te
8f60: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 st tlsIO-11.5 {r
8f70: 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c emote echo, 50 l
8f80: 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ines} {socket do
8f90: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8fa0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
8fb0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 dCommand "set ca
8fc0: 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 Cert $caCert".
8fd0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8fe0: 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 et serverCert $s
8ff0: 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 erverCert". s
9000: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
9010: 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 clientCert $clie
9020: 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 ntCert". send
9030: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
9040: 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 verKey $serverKe
9050: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
9060: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 nd "set clientKe
9070: 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 y $clientKey".
9080: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
9090: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f .set socket10_7_
90a0: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
90b0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
90c0: 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 accept \...-cer
90d0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
90e0: 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 t \...-cafile $c
90f0: 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 aCert \...-keyfi
9100: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
9110: 09 09 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 ..2836]..proc ac
9120: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
9130: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
9140: 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 ke $s.. filee
9150: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
9160: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
9170: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9180: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
9190: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
91a0: 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 crlf..}..proc ec
91b0: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 ho {s} {.. se
91c0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 t l [gets $s]..
91d0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
91e0: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 {...close $s..
91f0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 } else {...pu
9200: 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a ts $s $l.. }.
9210: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
9220: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
9230: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9240: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9250: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9260: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9270: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9280: 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 erverIP 2836].
9290: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 fconfigure $f
92a0: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
92b0: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
92c0: 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 e. for {set c
92d0: 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 nt 0} {$cnt < 50
92e0: 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 } {incr cnt} {..
92f0: 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 puts $f "hello,
9300: 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 69 $cnt"..if {[stri
9310: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 73 ng compare [gets
9320: 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 6e $f] "hello, $cn
9330: 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 t"] != 0} {..
9340: 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a break..}. }.
9350: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
9360: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
9370: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f ose $socket10_7_
9380: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
9390: 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 set cnt.} 50..#
93a0: 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 Macintosh socke
93b0: 74 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 ts can have more
93c0: 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 than one server
93d0: 20 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 per port.if {$t
93e0: 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 cl_platform(plat
93f0: 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e 74 form) == "macint
9400: 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 osh"} {. set
9410: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b conflictResult {
9420: 30 20 32 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0 2836}.} else {
9430: 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 . set conflic
9440: 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c tResult {1 {coul
9450: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
9460: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
9470: 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 y in use}}.}..te
9480: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 st tlsIO-11.6 {s
9490: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
94a0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
94b0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
94c0: 20 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 {. set s1 [t
94d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
94e0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
94f0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
9500: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9510: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
9520: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
9530: 74 20 32 38 33 36 5d 0a 20 20 20 20 69 66 20 7b t 2836]. if {
9540: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b [catch {set s2 [
9550: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9560: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
9570: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9580: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9590: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
95a0: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
95b0: 70 74 20 32 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 pt 2836]} msg]}
95c0: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c {..set result [l
95d0: 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 ist 1 $msg].
95e0: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 } else {..set re
95f0: 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 sult [list 0 [li
9600: 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 ndex [fconfigure
9610: 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 $s2 -sockname]
9620: 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 2]]..close $s2.
9630: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
9640: 73 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c s1. set resul
9650: 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 t.} $conflictRes
9660: 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ult..test tlsIO-
9670: 31 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 11.7 {server wit
9680: 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 h several client
9690: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
96a0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
96b0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
96c0: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
96d0: 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 ket10_9_test_ser
96e0: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
96f0: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 5b \...-certfile [
9700: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9710: 63 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 6d certs server.pem
9720: 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 ] \...-cafile [f
9730: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9740: 65 72 74 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d erts caFile.pem]
9750: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 \...-keyfile [f
9760: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9770: 65 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c erts skey.pem] \
9780: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
9790: 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 2836]..proc ac
97a0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
97b0: 20 20 20 20 23 20 68 61 6e 64 73 68 61 6b 65 20 # handshake
97c0: 6c 6f 63 6b 73 20 75 70 20 74 68 65 20 74 68 72 locks up the thr
97d0: 65 65 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 63 ee synchronous c
97e0: 6c 69 65 6e 74 73 0a 09 20 20 20 20 23 20 74 6c lients.. # tl
97f0: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
9800: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9810: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
9820: 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e ne.. fileeven
9830: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
9840: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a ist echo $s]..}.
9850: 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b .proc echo {s} {
9860: 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 .. set l [get
9870: 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b s $s].. if {[
9880: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f eof $s]} {...clo
9890: 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 se $s.. } els
98a0: 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c e {...puts $s $l
98b0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
98c0: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
98d0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
98e0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
98f0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
9900: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9910: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9920: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9930: 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 2836]. fconf
9940: 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 igure $s1 -buffe
9950: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
9960: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
9970: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
9980: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
9990: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
99a0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
99b0: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
99c0: 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a eServerIP 2836].
99d0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
99e0: 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s2 -buffering li
99f0: 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 ne. set s3 [t
9a00: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9a10: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9a20: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9a30: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9a40: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9a50: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9a60: 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 2836]. fco
9a70: 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 nfigure $s3 -buf
9a80: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
9a90: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
9aa0: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
9ab0: 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 } {..puts $s1 he
9ac0: 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 llo,s1..gets $s1
9ad0: 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f ..puts $s2 hello
9ae0: 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 ,s2..gets $s2..p
9af0: 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 uts $s3 hello,s3
9b00: 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d ..gets $s3. }
9b10: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
9b20: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
9b30: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 close $s3. s
9b40: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
9b50: 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 e $socket10_9_te
9b60: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
9b70: 65 74 20 69 0a 7d 20 31 30 30 20 20 20 20 0a 0a et i.} 100 ..
9b80: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 38 20 test tlsIO-11.8
9b90: 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 73 65 76 {client with sev
9ba0: 65 72 61 6c 20 73 65 72 76 65 72 73 7d 20 7b 65 eral servers} {e
9bb0: 6d 70 74 79 20 73 6f 63 6b 65 74 20 64 6f 54 65 mpty socket doTe
9bc0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
9bd0: 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 74 68 69 ver} {. # thi
9be0: 73 20 6f 6e 65 20 73 65 65 6d 73 20 74 6f 20 68 s one seems to h
9bf0: 61 6e 67 20 2d 2d 20 61 77 62 20 36 2f 32 2f 32 ang -- awb 6/2/2
9c00: 30 30 30 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 000. sendComm
9c10: 61 6e 64 20 7b 0a 09 73 65 74 20 73 31 20 5b 74 and {..set s1 [t
9c20: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
9c30: 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a certfile [file j
9c40: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9c50: 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 server.pem] \...
9c60: 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f -cafile [file jo
9c70: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 in [pwd] certs c
9c80: 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d aFile.pem] \...-
9c90: 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f keyfile [file jo
9ca0: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 in [pwd] certs s
9cb0: 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 key.pem] \...-se
9cc0: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
9cd0: 33 22 20 34 30 30 33 5d 0a 09 73 65 74 20 73 32 3" 4003]..set s2
9ce0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9cf0: 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c ..-certfile [fil
9d00: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
9d10: 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c ts server.pem] \
9d20: 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 ...-cafile [file
9d30: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9d40: 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a s caFile.pem] \.
9d50: 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 ..-keyfile [file
9d60: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9d70: 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 s skey.pem] \...
9d80: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
9d90: 34 30 30 34 22 20 34 30 30 34 5d 0a 09 73 65 74 4004" 4004]..set
9da0: 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s3 [tls::socket
9db0: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 5b \...-certfile [
9dc0: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9dd0: 63 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 6d certs server.pem
9de0: 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 ] \...-cafile [f
9df0: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9e00: 65 72 74 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d erts caFile.pem]
9e10: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 \...-keyfile [f
9e20: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9e30: 65 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c erts skey.pem] \
9e40: 0a 09 09 2d 73 65 72 76 65 72 20 22 61 63 63 65 ...-server "acce
9e50: 70 74 20 34 30 30 35 22 20 34 30 30 35 5d 0a 09 pt 4005" 4005]..
9e60: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 20 proc accept {mp
9e70: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
9e80: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
9e90: 09 20 20 20 20 70 75 74 73 20 24 73 20 24 6d 70 . puts $s $mp
9ea0: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
9eb0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
9ec0: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
9ed0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9ee0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9ef0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9f00: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9f10: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9f20: 65 72 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 erverIP 4003].
9f30: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
9f40: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9f50: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9f60: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9f70: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9f80: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9f90: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 emoteServerIP 40
9fa0: 30 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 5b 04]. set s3 [
9fb0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9fc0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
9fd0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
9fe0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9ff0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
a000: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
a010: 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 rIP 4005]. se
a020: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
a030: 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 nd l [gets $s1]
a040: 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 [gets $s1] [eof
a050: 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 $s1] [gets $s2]
a060: 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 [gets $s2] [eof
a070: 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 $s2] \..[gets $s
a080: 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 3] [gets $s3] [e
a090: 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 of $s3]. clos
a0a0: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
a0b0: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
a0c0: 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 3. sendComman
a0d0: 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 d {..close $s1..
a0e0: 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 close $s2..close
a0f0: 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 $s3. }. s
a100: 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 et l.} {4003 {}
a110: 31 20 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 1 4004 {} 1 4005
a120: 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 {} 1}..test tls
a130: 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 IO-11.9 {accept
a140: 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 callback error}
a150: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
a160: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a170: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
a180: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
a190: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
a1a0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
a1b0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a1c0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
a1d0: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
a1e0: 20 32 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 2836]. proc
a1f0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
a200: 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 expr 10 / 0}.
a210: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
a220: 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 gs {..global x..
a230: 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 set x $args.
a240: 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e }. sendComman
a250: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
a260: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
a270: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
a280: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
a290: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
a2a0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
a2b0: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
a2c0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a2d0: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
a2e0: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
a2f0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a300: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
a310: 6e 74 4b 65 79 22 0a 20 20 20 20 69 66 20 7b 5b ntKey". if {[
a320: 63 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 catch {sendComma
a330: 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 nd {.. set pe
a340: 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 ername [fconfigu
a350: 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 re $callerSocket
a360: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 -peername]..
a370: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
a380: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
a390: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 5c 0a e $clientCert \.
a3a0: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
a3b0: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
a3c0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
a3d0: 20 09 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 6e .[lindex $peern
a3e0: 61 6d 65 20 30 5d 20 32 38 33 36 5d 0a 09 20 20 ame 0] 2836]..
a3f0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 close $s. .
a400: 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f }} msg]} {..clo
a410: 73 65 20 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 se $s..error $ms
a420: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
a430: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
a440: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
a450: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
a460: 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 x. after canc
a470: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
a480: 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d ose $s. renam
a490: 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 e bgerror {}.
a4a0: 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 set x.} {{divid
a4b0: 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 e by zero}}..tes
a4c0: 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 20 7b 74 t tlsIO-11.10 {t
a4d0: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
a4e0: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
a4f0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
a500: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a510: 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 {. sendComma
a520: 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 nd "set caCert $
a530: 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 caCert". send
a540: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
a550: 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 verCert $serverC
a560: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a570: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
a580: 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 Cert $clientCert
a590: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a5a0: 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 d "set serverKey
a5b0: 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 $serverKey".
a5c0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
a5d0: 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 t clientKey $cli
a5e0: 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 entKey". send
a5f0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
a600: 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f ocket10_12_test_
a610: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
a620: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
a630: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
a640: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
a650: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
a660: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
a670: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
a680: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
a690: 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 {s a p} {close $
a6a0: 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s}. }. set
a6b0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
a6c0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
a6d0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
a6e0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a6f0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
a700: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
a710: 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 erverIP 2836].
a720: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
a730: 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 ure $s -peername
a740: 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f ]. set n [fco
a750: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
a760: 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 name]. set l
a770: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
a780: 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b [lindex $p 2] [
a790: 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 llength $p] [lle
a7a0: 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f ngth $p]. clo
a7b0: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
a7c0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
a7d0: 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 cket10_12_test_s
a7e0: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c erver}. set l
a7f0: 0a 7d 20 7b 32 38 33 36 20 33 20 33 7d 0a 0a 74 .} {2836 3 3}..t
a800: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 31 20 est tlsIO-11.11
a810: 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 {testing spuriou
a820: 73 20 65 76 65 6e 74 73 7d 20 7b 65 6d 70 74 79 s events} {empty
a830: 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 socket doTestsW
a840: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a850: 20 7b 0a 20 20 20 20 23 20 68 61 6e 67 73 0a 20 {. # hangs.
a860: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a870: 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 set caCert $caCe
a880: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
a890: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 and "set serverC
a8a0: 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 ert $serverCert"
a8b0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a8c0: 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 "set clientCert
a8d0: 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 $clientCert".
a8e0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
a8f0: 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 et serverKey $se
a900: 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e rverKey". sen
a910: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
a920: 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b ientKey $clientK
a930: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
a940: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
a950: 74 31 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 t10_13_test_serv
a960: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
a970: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
a980: 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 erverCert \...-c
a990: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
a9a0: 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 ..-keyfile $serv
a9b0: 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 erKey \...-serve
a9c0: 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 r accept 2836]..
a9d0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
a9e0: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
a9f0: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
aa00: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
aa10: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 -translation "au
aa20: 74 6f 20 6c 66 22 0a 09 20 20 20 20 61 66 74 65 to lf".. afte
aa30: 72 20 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 r 100 writesome
aa40: 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 $s..}..proc writ
aa50: 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 esome {s} {..
aa60: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
aa70: 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 $i < 100} {incr
aa80: 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 i} {...puts $s "
aa90: 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d line $i from rem
aaa0: 6f 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 ote server"..
aab0: 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 }.. close $s
aac0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
aad0: 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 t len 0. set
aae0: 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 spurious 0. s
aaf0: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 et done 0. pr
ab00: 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 oc readlittle {s
ab10: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 } {..global spur
ab20: 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 ious done len..s
ab30: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d et l [read $s 1]
ab40: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 ..if {[string le
ab50: 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b ngth $l] == 0} {
ab60: 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 .. if {![eof
ab70: 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 $s]} {...incr sp
ab80: 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c urious.. } el
ab90: 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a se {...close $s.
aba0: 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 ..set done 1..
abb0: 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 }..} else {..
abc0: 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 incr len [str
abd0: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 ing length $l]..
abe0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
abf0: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c c [tls::socket \
ac00: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
ac10: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
ac20: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
ac30: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
ac40: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
ac50: 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 rverIP 2836].
ac60: 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 fileevent $c re
ac70: 61 64 61 62 6c 65 20 22 72 65 61 64 6c 69 74 74 adable "readlitt
ac80: 6c 65 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 le $c". set t
ac90: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
aca0: 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 0 "set done time
acb0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
acc0: 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 t done. after
acd0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
ace0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
acf0: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
ad00: 31 33 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 13_test_server}.
ad10: 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f list $spurio
ad20: 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 us $len.} {0 269
ad30: 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 0}..test tlsIO-1
ad40: 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 1.12 {testing EO
ad50: 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 73 F stickyness} {s
ad60: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
ad70: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
ad80: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 65 72 . set counter
ad90: 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 0. set done
ada0: 30 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 0. proc count
adb0: 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 _up {s} {..globa
adc0: 6c 20 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 l counter done a
add0: 66 74 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b fter_id..set l [
ade0: 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 gets $s]..if {[e
adf0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 of $s]} {.. i
ae00: 6e 63 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 ncr counter..
ae10: 20 69 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 if {$counter >
ae20: 39 7d 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 9} {...set done
ae30: 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a {EOF is sticky}.
ae40: 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
ae50: 61 66 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 after_id...close
ae60: 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $s.. }..}.
ae70: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d }. proc tim
ae80: 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f ed_out {} {..glo
ae90: 62 61 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 bal c done..set
aea0: 64 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c done {timed_out,
aeb0: 20 45 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 63 EOF is not stic
aec0: 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 ky}..close $c.
aed0: 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d }. sendComm
aee0: 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 and "set caCert
aef0: 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e $caCert". sen
af00: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
af10: 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 rverCert $server
af20: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
af30: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
af40: 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 tCert $clientCer
af50: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
af60: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 nd "set serverKe
af70: 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 y $serverKey".
af80: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
af90: 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c et clientKey $cl
afa0: 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e ientKey". sen
afb0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
afc0: 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 socket10_14_test
afd0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
afe0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
aff0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c le $serverCert \
b000: 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 ...-cafile $caCe
b010: 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 rt \...-keyfile
b020: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
b030: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
b040: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
b050: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
b060: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
b070: 73 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 s.. after 100
b080: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
b090: 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c }. set c [tl
b0a0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
b0b0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
b0c0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
b0d0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b0e0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
b0f0: 20 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 .$remoteServerI
b100: 50 20 32 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 P 2836]. file
b110: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
b120: 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a e "count_up $c".
b130: 20 20 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 set after_id
b140: 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 6d [after 1000 tim
b150: 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 ed_out]. vwai
b160: 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 t done. sendC
b170: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
b180: 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f ocket10_14_test_
b190: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
b1a0: 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 done.} {EOF is s
b1b0: 74 69 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 ticky}..test tls
b1c0: 49 4f 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e IO-11.13 {testin
b1d0: 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 g async write, a
b1e0: 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e sync flush, asyn
b1f0: 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 c close} \..{soc
b200: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
b210: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
b220: 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b proc readit {
b230: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
b240: 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b nt done..set l [
b250: 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 read $s]..incr c
b260: 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e ount [string len
b270: 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f gth $l]..if {[eo
b280: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c f $s]} {.. cl
b290: 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 ose $s.. set
b2a0: 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a done 1..}. }.
b2b0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b2c0: 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 "set caCert $caC
b2d0: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
b2e0: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
b2f0: 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 Cert $serverCert
b300: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
b310: 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 d "set clientCer
b320: 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 t $clientCert".
b330: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
b340: 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 set serverKey $s
b350: 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 erverKey". se
b360: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
b370: 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 lientKey $client
b380: 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d Key". sendCom
b390: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 mand {..set firs
b3a0: 74 62 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b tblock ""..for {
b3b0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 set i 0} {$i < 5
b3c0: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 73 } {incr i} {...s
b3d0: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 61 et firstblock "a
b3e0: 24 66 69 72 73 74 62 6c 6f 63 6b 24 66 69 72 73 $firstblock$firs
b3f0: 74 62 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 tblock"..}..set
b400: 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a 09 secondblock ""..
b410: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
b420: 69 20 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d i < 16} {incr i}
b430: 20 7b 0a 09 20 20 20 20 73 65 74 20 73 65 63 6f {.. set seco
b440: 6e 64 62 6c 6f 63 6b 20 22 62 24 73 65 63 6f 6e ndblock "b$secon
b450: 64 62 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 6c 6f dblock$secondblo
b460: 63 6b 22 0a 09 7d 0a 09 73 65 74 20 6c 20 5b 74 ck"..}..set l [t
b470: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
b480: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
b490: 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 Cert \...-cafile
b4a0: 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 $caCert \...-ke
b4b0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
b4c0: 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 \...-server acc
b4d0: 65 70 74 20 32 38 34 35 5d 0a 09 70 72 6f 63 20 ept 2845]..proc
b4e0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
b4f0: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
b500: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 63 6f hake $s.. fco
b510: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
b520: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 king 0 -translat
b530: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 ion lf -buffersi
b540: 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 ze 16384 \...-bu
b550: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 ffering line..
b560: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
b570: 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 6c eadable "readabl
b580: 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 e $s"..}..proc r
b590: 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 eadable {s} {..
b5a0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
b5b0: 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e s].. fileeven
b5c0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d t $s readable {}
b5d0: 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 .. after 1000
b5e0: 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 respond $s..}..
b5f0: 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d proc respond {s}
b600: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 {.. global f
b610: 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 irstblock.. p
b620: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
b630: 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 s $firstblock..
b640: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 77 72 after 1000 wr
b650: 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 itedata $s..}..p
b660: 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 roc writedata {s
b670: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
b680: 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 secondblock..
b690: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
b6a0: 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b $s $secondblock
b6b0: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
b6c0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
b6d0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
b6e0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
b6f0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
b700: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
b710: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
b720: 5c 0a 20 20 20 20 09 24 72 65 6d 6f 74 65 53 65 \. .$remoteSe
b730: 72 76 65 72 49 50 20 32 38 34 35 5d 0a 20 20 20 rverIP 2845].
b740: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
b750: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
b760: 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 s lf -buffering
b770: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 line. set cou
b780: 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 nt 0. puts $s
b790: 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 hello. filee
b7a0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
b7b0: 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 "readit $s".
b7c0: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
b7d0: 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 10000 "set don
b7e0: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
b7f0: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
b800: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
b810: 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d imer. sendCom
b820: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a mand {close $l}.
b830: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 set count.}
b840: 36 35 35 36 36 0a 0a 74 65 73 74 20 74 6c 73 49 65566..test tlsI
b850: 4f 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 O-12.1 {testing
b860: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 73 inheritance of s
b870: 65 72 76 65 72 20 73 6f 63 6b 65 74 73 7d 20 5c erver sockets} \
b880: 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 ..{socket doTest
b890: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
b8a0: 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 r} {. removeF
b8b0: 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 ile script1.
b8c0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
b8d0: 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 t2.. # Script
b8e0: 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 1 is just a 10 s
b8f0: 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 econd delay. If
b900: 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b the server sock
b910: 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 et. # is inhe
b920: 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 rited, it will b
b930: 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 e held open for
b940: 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 10 seconds..
b950: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
b960: 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt1 w]. puts
b970: 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 $f {..after 1000
b980: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
b990: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
b9a0: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
b9b0: 53 63 72 69 70 74 32 20 63 72 65 61 74 65 73 20 Script2 creates
b9c0: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
b9d0: 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 t, launches scri
b9e0: 70 74 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 pt1,. # waits
b9f0: 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 a second, and e
ba00: 78 69 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 xits. The serve
ba10: 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f r socket will no
ba20: 77 0a 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 w. # be close
ba30: 64 20 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 d unless script1
ba40: 20 69 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a inherited it...
ba50: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
ba60: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 23 script2 w]. #
ba70: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
ba80: 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 63 et tcltest $::tc
ba90: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a ltest::tcltest].
baa0: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
bab0: 74 20 73 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 t set tclsh [inf
bac0: 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 o nameofexecutab
bad0: 6c 65 5d 5d 0a 20 20 20 20 70 75 74 73 20 24 66 le]]. puts $f
bae0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
baf0: 69 72 65 20 74 63 6c 74 65 73 74 0a 09 70 61 63 ire tcltest..pac
bb00: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
bb10: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
bb20: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
bb30: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
bb40: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
bb50: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
bb60: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
bb70: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
bb80: 20 32 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 2828 \]". pu
bb90: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
bba0: 63 65 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 cept { file addr
bbb0: 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 port } {.. c
bbc0: 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 23 lose $file..}..#
bbd0: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
bbe0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
bbf0: 31 20 26 0a 09 65 78 65 63 20 24 74 63 6c 73 68 1 &..exec $tclsh
bc00: 20 73 63 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 script1 &..clos
bc10: 65 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 e $f..after 1000
bc20: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
bc30: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
bc40: 6c 6f 73 65 20 24 66 0a 09 0a 20 20 20 20 23 20 lose $f... #
bc50: 4c 61 75 6e 63 68 20 73 63 72 69 70 74 32 20 61 Launch script2 a
bc60: 6e 64 20 77 61 69 74 20 35 20 73 65 63 6f 6e 64 nd wait 5 second
bc70: 73 0a 0a 20 20 20 20 23 20 65 78 65 63 20 24 3a s.. # exec $:
bc80: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
bc90: 74 20 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 t script2 &.
bca0: 65 78 65 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f exec [info nameo
bcb0: 66 65 78 65 63 75 74 61 62 6c 65 5d 20 73 63 72 fexecutable] scr
bcc0: 69 70 74 32 20 26 0a 20 20 20 20 61 66 74 65 72 ipt2 &. after
bcd0: 20 35 30 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 5000 { set ok_t
bce0: 6f 5f 70 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 o_proceed 1 }.
bcf0: 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 vwait ok_to_pr
bd00: 6f 63 65 65 64 0a 0a 20 20 20 20 23 20 49 66 20 oceed.. # If
bd10: 77 65 20 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e we can still con
bd20: 6e 65 63 74 20 74 6f 20 74 68 65 20 73 65 72 76 nect to the serv
bd30: 65 72 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 67 er, the socket g
bd40: 6f 74 20 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 ot inherited...
bd50: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
bd60: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
bd70: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
bd80: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
bd90: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
bda0: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 ientKey \. . 1
bdb0: 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 27.0.0.1 2828} m
bdc0: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 sg]} {..set x {s
bdd0: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
bde0: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
bdf0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c } else {..cl
be00: 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 ose $msg..set x
be10: 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 {server socket w
be20: 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 as inherited}.
be30: 20 20 7d 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 }.. removeF
be40: 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 ile script1.
be50: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
be60: 74 32 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b t2. set x.} {
be70: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 server socket wa
be80: 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d s not inherited}
be90: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e ..test tlsIO-12.
bea0: 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 2 {testing inher
beb0: 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 itance of client
bec0: 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f sockets} \..{so
bed0: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
bee0: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
bef0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
bf00: 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 cript1. remov
bf10: 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 eFile script2..
bf20: 20 20 20 23 20 53 63 72 69 70 74 31 20 69 73 20 # Script1 is
bf30: 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 just a 10 second
bf40: 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 delay. If the
bf50: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 server socket.
bf60: 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 # is inherited
bf70: 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c , it will be hel
bf80: 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 d open for 10 se
bf90: 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 conds.. set f
bfa0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 [open script1 w
bfb0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
bfc0: 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 .after 10000 exi
bfd0: 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 t..vwait forever
bfe0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
bff0: 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 $f.. # Scrip
c000: 74 32 20 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 t2 opens the cli
c010: 65 6e 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 ent socket and w
c020: 72 69 74 65 73 20 74 6f 20 69 74 2e 20 20 49 74 rites to it. It
c030: 20 74 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e then. # laun
c040: 63 68 65 73 20 73 63 72 69 70 74 31 20 61 6e 64 ches script1 and
c050: 20 65 78 69 74 73 2e 20 20 49 66 20 74 68 65 20 exits. If the
c060: 63 68 69 6c 64 20 70 72 6f 63 65 73 73 20 69 6e child process in
c070: 68 65 72 69 74 65 64 20 74 68 65 0a 20 20 20 20 herited the.
c080: 23 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c # client socket,
c090: 20 74 68 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c the socket will
c0a0: 20 73 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a still be open..
c0b0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
c0c0: 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 script2 w].
c0d0: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
c0e0: 74 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 t tclsh [info na
c0f0: 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 5d meofexecutable]]
c100: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 . puts $f {.
c110: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
c120: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
c130: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
c140: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
c150: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
c160: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c170: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
c180: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
c190: 2e 31 20 32 38 32 39 20 5c 5d 22 0a 20 20 20 20 .1 2829 \]".
c1a0: 70 75 74 73 20 24 66 20 7b 0a 09 65 78 65 63 20 puts $f {..exec
c1b0: 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 $tclsh script1 &
c1c0: 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 69 6e ..puts $f testin
c1d0: 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 66 74 g..flush $f..aft
c1e0: 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 er 1000 exit..vw
c1f0: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
c200: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
c210: 20 20 20 20 23 20 43 72 65 61 74 65 20 74 68 65 # Create the
c220: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 0a server socket..
c230: 20 20 20 20 73 65 74 20 73 65 72 76 65 72 20 5b set server [
c240: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
c250: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
c260: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c270: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
c280: 65 72 76 65 72 4b 65 79 20 5c 0a 09 2d 73 65 72 erverKey \..-ser
c290: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 39 5d ver accept 2829]
c2a0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
c2b0: 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 { file host por
c2c0: 74 20 7d 20 7b 0a 0a 09 23 20 57 68 65 6e 20 74 t } {...# When t
c2d0: 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 he client connec
c2e0: 74 73 2c 20 65 73 74 61 62 6c 69 73 68 20 74 68 ts, establish th
c2f0: 65 20 72 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 e read handler..
c300: 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a 09 63 global server..c
c310: 6c 6f 73 65 20 24 73 65 72 76 65 72 0a 09 66 69 lose $server..fi
c320: 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 20 72 65 leevent $file re
c330: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 adable [list get
c340: 64 61 74 61 20 24 66 69 6c 65 5d 0a 09 66 63 6f data $file]..fco
c350: 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 nfigure $file -b
c360: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 62 uffering line -b
c370: 6c 6f 63 6b 69 6e 67 20 30 0a 09 72 65 74 75 72 locking 0..retur
c380: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 n. }. proc
c390: 20 67 65 74 64 61 74 61 20 7b 20 66 69 6c 65 20 getdata { file
c3a0: 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 61 6e } {...# Read han
c3b0: 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 63 65 dler on the acce
c3c0: 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 09 67 6c pted socket...gl
c3d0: 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 obal x..global f
c3e0: 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 74 75 ailed..set statu
c3f0: 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 s [catch {read $
c400: 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 file} data]..if
c410: 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d 20 7b {$status != 0} {
c420: 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 65 61 .. set x {rea
c430: 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 d failed, error
c440: 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 20 20 was $data}..
c450: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
c460: 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 ile }..} elseif
c470: 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 {[string compare
c480: 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d {} $data]} {..}
c490: 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b elseif {[fblock
c4a0: 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 ed $file]} {..}
c4b0: 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 elseif {[eof $fi
c4c0: 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b le]} {.. if {
c4d0: 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 $failed} {...set
c4e0: 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 x {client socke
c4f0: 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d t was inherited}
c500: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
c510: 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 .set x {client s
c520: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
c530: 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a herited}.. }.
c540: 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f . catch { clo
c550: 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c se $file }..} el
c560: 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 se {.. set x
c570: 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 {impossible case
c580: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
c590: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a lose $file }..}.
c5a0: 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 .return. }..
c5b0: 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b # If the sock
c5c0: 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 20 65 et doesn't hit e
c5d0: 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 nd-of-file in 5
c5e0: 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 seconds, the.
c5f0: 20 23 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 # script1 proce
c600: 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 ss must have inh
c610: 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 65 6e erited the clien
c620: 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c t... set fail
c630: 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 ed 0. after 5
c640: 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 66 61 000 [list set fa
c650: 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c iled 1].. # L
c660: 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 aunch the script
c670: 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 2 process.. e
c680: 78 65 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 xec [info nameof
c690: 65 78 65 63 75 74 61 62 6c 65 5d 20 73 63 72 69 executable] scri
c6a0: 70 74 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 pt2 &.. vwait
c6b0: 20 78 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 x. if {!$fai
c6c0: 6c 65 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 led} {..vwait fa
c6d0: 69 6c 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 72 iled. }. r
c6e0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
c6f0: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
c700: 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 script2. set
c710: 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 x.} {client soc
c720: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
c730: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 rited}..test tls
c740: 49 4f 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 IO-12.3 {testing
c750: 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 inheritance of
c760: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 accepted sockets
c770: 7d 20 5c 0a 09 7b 65 6d 70 74 79 20 73 6f 63 6b } \..{empty sock
c780: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
c790: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
c7a0: 20 20 23 20 68 61 6e 67 73 20 6f 6e 20 4c 69 6e # hangs on Lin
c7b0: 75 78 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c ux. removeFil
c7c0: 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 e script1. re
c7d0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 moveFile script2
c7e0: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
c7f0: 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 n script1 w].
c800: 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 puts $f {..afte
c810: 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 r 10000 exit..vw
c820: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
c830: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
c840: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
c850: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 script2 w]. p
c860: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
c870: 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d tclsh [info nam
c880: 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a eofexecutable]].
c890: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 puts $f {.
c8a0: 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 .package requi
c8b0: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
c8c0: 20 70 75 74 73 20 24 66 20 22 63 61 74 63 68 20 puts $f "catch
c8d0: 7b 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f {set f \[tls::so
c8e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
c8f0: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
c900: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
c910: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
c920: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 39 le $serverKey 29
c930: 33 30 20 5c 5d 7d 22 0a 20 20 20 20 70 75 74 73 30 \]}". puts
c940: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
c950: 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 pt { file host p
c960: 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f ort } {.. glo
c970: 62 61 6c 20 74 63 6c 73 68 0a 09 20 20 20 20 70 bal tclsh.. p
c980: 75 74 73 20 24 66 69 6c 65 20 7b 74 65 73 74 20 uts $file {test
c990: 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a data on socket}.
c9a0: 09 20 20 20 20 65 78 65 63 20 24 74 63 6c 73 68 . exec $tclsh
c9b0: 20 73 63 72 69 70 74 31 20 26 0a 09 20 20 20 20 script1 &..
c9c0: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
c9d0: 09 7d 0a 09 63 61 74 63 68 20 7b 76 77 61 69 74 .}..catch {vwait
c9e0: 20 66 6f 72 65 76 65 72 7d 0a 20 20 20 20 7d 0a forever}. }.
c9f0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
ca00: 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 # Launch the s
ca10: 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 20 61 cript2 process a
ca20: 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 nd connect to it
ca30: 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a . See how long.
ca40: 20 20 20 20 23 20 74 68 65 20 73 6f 63 6b 65 74 # the socket
ca50: 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 stays open..
ca60: 20 65 78 65 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 exec [info name
ca70: 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 20 73 63 ofexecutable] sc
ca80: 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61 66 74 ript2 &.. aft
ca90: 65 72 20 31 30 30 30 20 73 65 74 20 6f 6b 5f 74 er 1000 set ok_t
caa0: 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 20 20 o_proceed 1.
cab0: 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 vwait ok_to_proc
cac0: 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66 20 5b eed.. set f [
cad0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
cae0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
caf0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
cb00: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
cb10: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
cb20: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 39 127.0.0.1 29
cb30: 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 30]. fconfigu
cb40: 72 65 20 24 66 20 2d 62 75 66 66 65 72 69 6e 67 re $f -buffering
cb50: 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 full -blocking
cb60: 30 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 0. fileevent
cb70: 24 66 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $f readable [lis
cb80: 74 20 67 65 74 64 61 74 61 20 24 66 5d 0a 0a 20 t getdata $f]..
cb90: 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b # If the sock
cba0: 65 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e et is still open
cbb0: 20 61 66 74 65 72 20 35 20 73 65 63 6f 6e 64 73 after 5 seconds
cbc0: 2c 20 74 68 65 20 73 63 72 69 70 74 31 20 70 72 , the script1 pr
cbd0: 6f 63 65 73 73 0a 20 20 20 20 23 20 6d 75 73 74 ocess. # must
cbe0: 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 have inherited
cbf0: 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 the accepted soc
cc00: 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ket... set fa
cc10: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
cc20: 20 35 30 30 30 20 73 65 74 20 66 61 69 6c 65 64 5000 set failed
cc30: 20 31 0a 0a 20 20 20 20 70 72 6f 63 20 67 65 74 1.. proc get
cc40: 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a data { file } {.
cc50: 0a 09 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 ..# Read handler
cc60: 20 6f 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 73 on the client s
cc70: 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 ocket...global x
cc80: 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a ..global failed.
cc90: 09 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 .set status [cat
cca0: 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 ch {read $file}
ccb0: 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 data]..if {$stat
ccc0: 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 us != 0} {..
ccd0: 73 65 74 20 78 20 7b 72 65 61 64 20 66 61 69 6c set x {read fail
cce0: 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 ed, error was $d
ccf0: 61 74 61 7d 0a 09 20 20 20 20 63 61 74 63 68 20 ata}.. catch
cd00: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
cd10: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 .} elseif {[stri
cd20: 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 ng compare {} $d
cd30: 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 ata]} {..} elsei
cd40: 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 f {[fblocked $fi
cd50: 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 le]} {..} elseif
cd60: 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b {[eof $file]} {
cd70: 0a 09 20 20 20 20 69 66 20 7b 24 66 61 69 6c 65 .. if {$faile
cd80: 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 d} {...set x {ac
cd90: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 cepted socket wa
cda0: 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 s inherited}..
cdb0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 } else {...set
cdc0: 20 78 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 x {accepted soc
cdd0: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
cde0: 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 rited}.. }..
cdf0: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
ce00: 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 $file }..} else
ce10: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 {.. set x {i
ce20: 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a mpossible case}.
ce30: 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f . catch { clo
ce40: 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 se $file }..}..r
ce50: 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 eturn. }.
ce60: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 0a 20 20 . vwait x..
ce70: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
ce80: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
ce90: 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 20 ile script2.
cea0: 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 set x.} {accepte
ceb0: 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 d socket was not
cec0: 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 inherited}..tes
ced0: 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 7b 54 65 t tlsIO-13.1 {Te
cee0: 73 74 69 6e 67 20 75 73 65 20 6f 66 20 73 68 61 sting use of sha
cef0: 72 65 64 20 73 6f 63 6b 65 74 20 62 65 74 77 65 red socket betwe
cf00: 65 6e 20 74 77 6f 20 74 68 72 65 61 64 73 7d 20 en two threads}
cf10: 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 \..{socket testt
cf20: 68 72 65 61 64 7d 20 7b 0a 0a 20 20 20 20 72 65 hread} {.. re
cf30: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
cf40: 20 20 20 20 74 68 72 65 61 64 52 65 61 70 0a 0a threadReap..
cf50: 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 makeFile {.
cf60: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
cf70: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b ire tls..set f [
cf80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
cf90: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d ver accept 2828]
cfa0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
cfb0: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
cfc0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
cfd0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
cfe0: 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 echo $s].
cff0: 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 fconfigure
d000: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
d010: 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 ne. }..pr
d020: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
d030: 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 global i.
d040: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 set l
d050: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
d060: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
d070: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
d080: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
d090: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d0a0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
d0b0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
d0c0: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
d0d0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 } else { ..
d0e0: 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 incr i.
d0f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d100: 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 puts $s $l.
d110: 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 }..}..se
d120: 74 20 69 20 30 0a 09 76 77 61 69 74 20 78 0a 09 t i 0..vwait x..
d130: 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 74 68 72 close $f...# thr
d140: 65 61 64 20 63 6c 65 61 6e 73 20 69 74 73 65 6c ead cleans itsel
d150: 66 20 75 70 2e 0a 09 74 65 73 74 74 68 72 65 61 f up...testthrea
d160: 64 20 65 78 69 74 0a 20 20 20 20 7d 20 73 63 72 d exit. } scr
d170: 69 70 74 0a 20 20 20 20 0a 20 20 20 20 23 20 63 ipt. . # c
d180: 72 65 61 74 65 20 61 20 74 68 72 65 61 64 0a 20 reate a thread.
d190: 20 20 20 73 65 74 20 73 65 72 76 65 72 74 68 72 set serverthr
d1a0: 65 61 64 20 5b 74 65 73 74 74 68 72 65 61 64 20 ead [testthread
d1b0: 63 72 65 61 74 65 20 7b 20 73 6f 75 72 63 65 20 create { source
d1c0: 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 20 20 75 script } ]. u
d1d0: 70 64 61 74 65 0a 20 20 20 20 0a 20 20 20 20 61 pdate. . a
d1e0: 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 fter 1000. se
d1f0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
d200: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 127.0.0.1 2828]
d210: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
d220: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
d230: 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 20 7b 0a ne.. catch {.
d240: 09 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 .puts $s "hello"
d250: 0a 09 67 65 74 73 20 24 73 20 72 65 73 75 6c 74 ..gets $s result
d260: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
d270: 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 0a $s. update..
d280: 20 20 20 20 61 66 74 65 72 20 32 30 30 30 0a 20 after 2000.
d290: 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c lappend resul
d2a0: 74 20 5b 74 68 72 65 61 64 52 65 61 70 5d 0a 20 t [threadReap].
d2b0: 20 20 20 0a 20 20 20 20 73 65 74 20 72 65 73 75 . set resu
d2c0: 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a lt..} {hello 1}.
d2d0: 0a 23 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b .# cleanup.if {[
d2e0: 73 74 72 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 string match soc
d2f0: 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 k* $commandSocke
d300: 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 t] == 1} {. pu
d310: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
d320: 74 20 65 78 69 74 0a 20 20 20 66 6c 75 73 68 20 t exit. flush
d330: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d $commandSocket.}
d340: 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 .catch {close $c
d350: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 ommandSocket}.ca
d360: 74 63 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f tch {close $remo
d370: 74 65 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 teProcChan}.::tc
d380: 6c 74 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 ltest::cleanupTe
d390: 73 74 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 sts.flush stdout
d3a0: 0a 72 65 74 75 72 6e 0a 0a .return..