0000: 23 20 43 6f 6d 6d 61 6e 64 73 20 74 65 73 74 65 # Commands teste
0010: 64 20 69 6e 20 74 68 69 73 20 66 69 6c 65 3a 20 d in this file:
0020: 73 6f 63 6b 65 74 2e 0a 23 0a 23 20 54 68 69 73 socket..#.# This
0030: 20 66 69 6c 65 20 63 6f 6e 74 61 69 6e 73 20 61 file contains a
0040: 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 6f 66 20 74 collection of t
0050: 65 73 74 73 20 66 6f 72 20 6f 6e 65 20 6f 72 20 ests for one or
0060: 6d 6f 72 65 20 6f 66 20 74 68 65 20 54 63 6c 0a more of the Tcl.
0070: 23 20 62 75 69 6c 74 2d 69 6e 20 63 6f 6d 6d 61 # built-in comma
0080: 6e 64 73 2e 20 20 53 6f 75 72 63 69 6e 67 20 74 nds. Sourcing t
0090: 68 69 73 20 66 69 6c 65 20 69 6e 74 6f 20 54 63 his file into Tc
00a0: 6c 20 72 75 6e 73 20 74 68 65 20 74 65 73 74 73 l runs the tests
00b0: 20 61 6e 64 0a 23 20 67 65 6e 65 72 61 74 65 73 and.# generates
00c0: 20 6f 75 74 70 75 74 20 66 6f 72 20 65 72 72 6f output for erro
00d0: 72 73 2e 20 20 4e 6f 20 6f 75 74 70 75 74 20 6d rs. No output m
00e0: 65 61 6e 73 20 6e 6f 20 65 72 72 6f 72 73 20 77 eans no errors w
00f0: 65 72 65 20 66 6f 75 6e 64 2e 0a 23 0a 23 20 43 ere found..#.# C
0100: 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 39 opyright (c) 199
0110: 34 2d 31 39 39 36 20 53 75 6e 20 4d 69 63 72 6f 4-1996 Sun Micro
0120: 73 79 73 74 65 6d 73 2c 20 49 6e 63 2e 0a 23 20 systems, Inc..#
0130: 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 31 39 Copyright (c) 19
0140: 39 38 2d 32 30 30 30 20 41 6a 75 62 61 20 53 6f 98-2000 Ajuba So
0150: 6c 75 74 69 6f 6e 73 2e 20 0a 23 0a 23 20 53 65 lutions. .#.# Se
0160: 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 63 65 e the file "lice
0170: 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 20 69 nse.terms" for i
0180: 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73 nformation on us
0190: 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 72 69 age and redistri
01a0: 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 69 73 bution.# of this
01b0: 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20 61 file, and for a
01c0: 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20 41 DISCLAIMER OF A
01d0: 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0a 23 LL WARRANTIES..#
01e0: 0a 23 20 52 43 53 3a 20 40 28 23 29 20 24 49 64 .# RCS: @(#) $Id
01f0: 3a 20 74 6c 73 49 4f 2e 74 65 73 74 2c 76 20 31 : tlsIO.test,v 1
0200: 2e 31 34 2e 32 2e 33 20 32 30 30 30 2f 30 37 2f .14.2.3 2000/07/
0210: 31 34 20 30 34 3a 31 30 3a 32 33 20 68 6f 62 62 14 04:10:23 hobb
0220: 73 20 45 78 70 20 24 0a 0a 23 20 52 75 6e 6e 69 s Exp $..# Runni
0230: 6e 67 20 73 6f 63 6b 65 74 20 74 65 73 74 73 20 ng socket tests
0240: 77 69 74 68 20 61 20 72 65 6d 6f 74 65 20 73 65 with a remote se
0250: 72 76 65 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d 2d rver:.# --------
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 2d ----------------
0280: 2d 2d 0a 23 20 0a 23 20 53 6f 6d 65 20 74 65 73 --.# .# Some tes
0290: 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 73 ts in socket.tes
02a0: 74 20 64 65 70 65 6e 64 20 6f 6e 20 74 68 65 20 t depend on the
02b0: 65 78 69 73 74 65 6e 63 65 20 6f 66 20 61 20 72 existence of a r
02c0: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 74 6f 0a emote server to.
02d0: 23 20 77 68 69 63 68 20 74 68 65 79 20 63 6f 6e # which they con
02e0: 6e 65 63 74 2e 20 54 68 65 20 72 65 6d 6f 74 65 nect. The remote
02f0: 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 server must be
0300: 61 6e 20 69 6e 73 74 61 6e 63 65 20 6f 66 20 74 an instance of t
0310: 63 6c 74 65 73 74 20 61 6e 64 20 69 74 0a 23 20 cltest and it.#
0320: 6d 75 73 74 20 72 75 6e 20 74 68 65 20 73 63 72 must run the scr
0330: 69 70 74 20 66 6f 75 6e 64 20 69 6e 20 74 68 65 ipt found in the
0340: 20 66 69 6c 65 20 22 72 65 6d 6f 74 65 2e 74 63 file "remote.tc
0350: 6c 22 20 69 6e 20 74 68 69 73 20 64 69 72 65 63 l" in this direc
0360: 74 6f 72 79 2e 20 59 6f 75 0a 23 20 63 61 6e 20 tory. You.# can
0370: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
0380: 20 73 65 72 76 65 72 20 6f 6e 20 61 6e 79 20 6d server on any m
0390: 61 63 68 69 6e 65 20 72 65 61 63 68 61 62 6c 65 achine reachable
03a0: 20 66 72 6f 6d 20 74 68 65 20 6d 61 63 68 69 6e from the machin
03b0: 65 20 6f 6e 0a 23 20 77 68 69 63 68 20 79 6f 75 e on.# which you
03c0: 20 77 61 6e 74 20 74 6f 20 72 75 6e 20 74 68 65 want to run the
03d0: 20 73 6f 63 6b 65 74 20 74 65 73 74 73 2c 20 62 socket tests, b
03e0: 79 20 69 73 73 75 69 6e 67 3a 0a 23 20 0a 23 20 y issuing:.# .#
03f0: 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f tcltest remo
0400: 74 65 2e 74 63 6c 20 2d 70 6f 72 74 20 38 30 34 te.tcl -port 804
0410: 38 09 23 20 4f 72 20 63 68 6f 6f 73 65 20 61 6e 8.# Or choose an
0420: 6f 74 68 65 72 20 70 6f 72 74 20 6e 75 6d 62 65 other port numbe
0430: 72 2e 0a 23 20 0a 23 20 49 66 20 74 68 65 20 6d r..# .# If the m
0440: 61 63 68 69 6e 65 20 79 6f 75 20 61 72 65 20 72 achine you are r
0450: 75 6e 6e 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 unning the remot
0460: 65 20 73 65 72 76 65 72 20 6f 6e 20 68 61 73 20 e server on has
0470: 73 65 76 65 72 61 6c 20 49 50 0a 23 20 69 6e 74 several IP.# int
0480: 65 72 66 61 63 65 73 2c 20 79 6f 75 20 63 61 6e erfaces, you can
0490: 20 63 68 6f 6f 73 65 20 77 68 69 63 68 20 69 6e choose which in
04a0: 74 65 72 66 61 63 65 20 74 68 65 20 73 65 72 76 terface the serv
04b0: 65 72 20 6c 69 73 74 65 6e 73 20 6f 6e 20 66 6f er listens on fo
04c0: 72 0a 23 20 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 r.# connections
04d0: 62 79 20 73 70 65 63 69 66 79 69 6e 67 20 74 68 by specifying th
04e0: 65 20 2d 61 64 64 72 65 73 73 20 63 6f 6d 6d 61 e -address comma
04f0: 6e 64 20 6c 69 6e 65 20 66 6c 61 67 2c 20 73 6f nd line flag, so
0500: 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 65 :.# .# tclte
0510: 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d 61 st remote.tcl -a
0520: 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 ddress your.mach
0530: 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 54 68 65 ine.com.# .# The
0540: 73 65 20 6f 70 74 69 6f 6e 73 20 63 61 6e 20 61 se options can a
0550: 6c 73 6f 20 62 65 20 73 65 74 20 62 79 20 65 6e lso be set by en
0560: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
0570: 6c 65 73 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 6f les. On Unix, yo
0580: 75 20 63 61 6e 0a 23 20 74 79 70 65 20 74 68 65 u can.# type the
0590: 73 65 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 se commands to t
05a0: 68 65 20 73 68 65 6c 6c 20 66 72 6f 6d 20 77 68 he shell from wh
05b0: 69 63 68 20 74 68 65 20 72 65 6d 6f 74 65 20 73 ich the remote s
05c0: 65 72 76 65 72 20 69 73 20 73 74 61 72 74 65 64 erver is started
05d0: 3a 0a 23 20 0a 23 20 20 20 20 20 73 68 65 6c 6c :.# .# shell
05e0: 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 50 % setenv serverP
05f0: 6f 72 74 20 38 30 34 38 0a 23 20 20 20 20 20 73 ort 8048.# s
0600: 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 73 65 72 hell% setenv ser
0610: 76 65 72 41 64 64 72 65 73 73 20 79 6f 75 72 2e verAddress your.
0620: 6d 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 machine.com.# .#
0630: 20 61 6e 64 20 73 75 62 73 65 71 75 65 6e 74 6c and subsequentl
0640: 79 20 79 6f 75 20 63 61 6e 20 73 74 61 72 74 20 y you can start
0650: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
0660: 72 20 77 69 74 68 3a 0a 23 20 0a 23 20 20 20 20 r with:.# .#
0670: 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e tcltest remote.
0680: 74 63 6c 0a 23 20 0a 23 20 74 6f 20 68 61 76 65 tcl.# .# to have
0690: 20 69 74 20 6c 69 73 74 65 6e 20 6f 6e 20 70 6f it listen on po
06a0: 72 74 20 38 30 34 38 20 6f 6e 20 74 68 65 20 69 rt 8048 on the i
06b0: 6e 74 65 72 66 61 63 65 20 79 6f 75 72 2e 6d 61 nterface your.ma
06c0: 63 68 69 6e 65 2e 63 6f 6d 2e 0a 23 20 20 20 20 chine.com..#
06d0: 20 0a 23 20 57 68 65 6e 20 74 68 65 20 73 65 72 .# When the ser
06e0: 76 65 72 20 73 74 61 72 74 73 2c 20 69 74 20 70 ver starts, it p
06f0: 72 69 6e 74 73 20 6f 75 74 20 61 20 64 65 74 61 rints out a deta
0700: 69 6c 65 64 20 6d 65 73 73 61 67 65 20 63 6f 6e iled message con
0710: 74 61 69 6e 69 6e 67 20 69 74 73 0a 23 20 63 6f taining its.# co
0720: 6e 66 69 67 75 72 61 74 69 6f 6e 20 69 6e 66 6f nfiguration info
0730: 72 6d 61 74 69 6f 6e 2c 20 61 6e 64 20 69 74 20 rmation, and it
0740: 77 69 6c 6c 20 62 6c 6f 63 6b 20 75 6e 74 69 6c will block until
0750: 20 6b 69 6c 6c 65 64 20 77 69 74 68 20 61 20 43 killed with a C
0760: 74 72 6c 2d 43 2e 0a 23 20 4f 6e 63 65 20 74 68 trl-C..# Once th
0770: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 e remote server
0780: 65 78 69 73 74 73 2c 20 79 6f 75 20 63 61 6e 20 exists, you can
0790: 72 75 6e 20 74 68 65 20 74 65 73 74 73 20 69 6e run the tests in
07a0: 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 77 69 74 socket.test wit
07b0: 68 0a 23 20 74 68 65 20 73 65 72 76 65 72 20 62 h.# the server b
07c0: 79 20 73 65 74 74 69 6e 67 20 74 77 6f 20 54 63 y setting two Tc
07d0: 6c 20 76 61 72 69 61 62 6c 65 73 3a 0a 23 20 0a l variables:.# .
07e0: 23 20 20 20 20 20 25 20 73 65 74 20 72 65 6d 6f # % set remo
07f0: 74 65 53 65 72 76 65 72 49 50 20 3c 6e 61 6d 65 teServerIP <name
0800: 20 6f 72 20 61 64 64 72 65 73 73 20 6f 66 20 6d or address of m
0810: 61 63 68 69 6e 65 20 6f 6e 20 77 68 69 63 68 20 achine on which
0820: 73 65 72 76 65 72 20 72 75 6e 73 3e 0a 23 20 20 server runs>.#
0830: 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 % set remoteS
0840: 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 erverPort 8048.#
0850: 20 0a 23 20 54 68 65 73 65 20 76 61 72 69 61 62 .# These variab
0860: 6c 65 73 20 61 72 65 20 61 6c 73 6f 20 73 65 74 les are also set
0870: 74 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 20 65 table from the e
0880: 6e 76 69 72 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 55 nvironment. On U
0890: 6e 69 78 2c 20 79 6f 75 20 63 61 6e 3a 0a 23 20 nix, you can:.#
08a0: 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 .# shell% se
08b0: 74 65 6e 76 20 72 65 6d 6f 74 65 53 65 72 76 65 tenv remoteServe
08c0: 72 49 50 20 6d 61 63 68 69 6e 65 2e 77 68 65 72 rIP machine.wher
08d0: 65 2e 73 65 72 76 65 72 2e 72 75 6e 73 0a 23 20 e.server.runs.#
08e0: 20 20 20 20 73 68 65 6c 6c 25 20 73 65 6e 65 74 shell% senet
08f0: 76 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f v remoteServerPo
0900: 72 74 20 38 30 34 38 0a 23 20 0a 23 20 54 68 65 rt 8048.# .# The
0910: 20 70 72 65 61 6d 62 6c 65 20 6f 66 20 74 68 65 preamble of the
0920: 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 69 6c socket.test fil
0930: 65 20 63 68 65 63 6b 73 20 74 6f 20 73 65 65 20 e checks to see
0940: 69 66 20 74 68 65 20 76 61 72 69 61 62 6c 65 73 if the variables
0950: 20 61 72 65 20 73 65 74 0a 23 20 65 69 74 68 65 are set.# eithe
0960: 72 20 69 6e 20 54 63 6c 20 6f 72 20 69 6e 20 74 r in Tcl or in t
0970: 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 3b 20 he environment;
0980: 69 66 20 74 68 65 79 20 61 72 65 2c 20 69 74 20 if they are, it
0990: 61 74 74 65 6d 70 74 73 20 74 6f 20 63 6f 6e 6e attempts to conn
09a0: 65 63 74 20 74 6f 0a 23 20 74 68 65 20 73 65 72 ect to.# the ser
09b0: 76 65 72 2e 20 49 66 20 74 68 65 20 63 6f 6e 6e ver. If the conn
09c0: 65 63 74 69 6f 6e 20 69 73 20 73 75 63 63 65 73 ection is succes
09d0: 73 66 75 6c 2c 20 74 68 65 20 74 65 73 74 73 20 sful, the tests
09e0: 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 using the remote
09f0: 0a 23 20 73 65 72 76 65 72 20 77 69 6c 6c 20 62 .# server will b
0a00: 65 20 70 65 72 66 6f 72 6d 65 64 3b 20 6f 74 68 e performed; oth
0a10: 65 72 77 69 73 65 2c 20 69 74 20 77 69 6c 6c 20 erwise, it will
0a20: 61 74 74 65 6d 70 74 20 74 6f 20 73 74 61 72 74 attempt to start
0a30: 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 the remote.# se
0a40: 72 76 65 72 20 28 76 69 61 20 65 78 65 63 29 20 rver (via exec)
0a50: 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 on platforms tha
0a60: 74 20 73 75 70 70 6f 72 74 20 74 68 69 73 2c 20 t support this,
0a70: 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f 73 on the local hos
0a80: 74 2c 0a 23 20 6c 69 73 74 65 6e 69 6e 67 20 61 t,.# listening a
0a90: 74 20 70 6f 72 74 20 38 30 34 38 2e 20 49 66 20 t port 8048. If
0aa0: 61 6c 6c 20 66 61 69 6c 73 2c 20 61 20 6d 65 73 all fails, a mes
0ab0: 73 61 67 65 20 69 73 20 70 72 69 6e 74 65 64 20 sage is printed
0ac0: 61 6e 64 20 74 68 65 20 74 65 73 74 73 0a 23 20 and the tests.#
0ad0: 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 65 using the remote
0ae0: 20 73 65 72 76 65 72 20 61 72 65 20 6e 6f 74 20 server are not
0af0: 70 65 72 66 6f 72 6d 65 64 2e 0a 0a 69 66 20 7b performed...if {
0b00: 5b 6c 73 65 61 72 63 68 20 5b 6e 61 6d 65 73 70 [lsearch [namesp
0b10: 61 63 65 20 63 68 69 6c 64 72 65 6e 5d 20 3a 3a ace children] ::
0b20: 74 63 6c 74 65 73 74 5d 20 3d 3d 20 2d 31 7d 20 tcltest] == -1}
0b30: 7b 0a 20 20 20 20 70 61 63 6b 61 67 65 20 72 65 {. package re
0b40: 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a 20 20 quire tcltest.
0b50: 20 20 6e 61 6d 65 73 70 61 63 65 20 69 6d 70 6f namespace impo
0b60: 72 74 20 2d 66 6f 72 63 65 20 3a 3a 74 63 6c 74 rt -force ::tclt
0b70: 65 73 74 3a 3a 2a 0a 7d 0a 0a 23 20 4c 6f 61 64 est::*.}..# Load
0b80: 20 74 68 65 20 74 6c 73 20 70 61 63 6b 61 67 65 the tls package
0b90: 0a 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
0ba0: 65 20 74 6c 73 0a 0a 73 65 74 20 74 6c 73 53 65 e tls..set tlsSe
0bb0: 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 0a 73 rverPort 8048..s
0bc0: 65 74 20 63 65 72 74 73 44 69 72 20 5b 66 69 6c et certsDir [fil
0bd0: 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 e join [file dir
0be0: 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70 name [info scrip
0bf0: 74 5d 5d 20 63 65 72 74 73 5d 20 0a 0a 73 65 74 t]] certs] ..set
0c00: 20 73 65 72 76 65 72 43 65 72 74 20 5b 66 69 6c serverCert [fil
0c10: 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 e join $certsDir
0c20: 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a 73 65 74 server.pem].set
0c30: 20 63 6c 69 65 6e 74 43 65 72 74 20 5b 66 69 6c clientCert [fil
0c40: 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 e join $certsDir
0c50: 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 65 74 client.pem].set
0c60: 20 63 61 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f caCert [file jo
0c70: 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 61 63 in $certsDir cac
0c80: 65 72 74 2e 70 65 6d 5d 0a 73 65 74 20 73 65 72 ert.pem].set ser
0c90: 76 65 72 4b 65 79 20 5b 66 69 6c 65 20 6a 6f 69 verKey [file joi
0ca0: 6e 20 24 63 65 72 74 73 44 69 72 20 73 6b 65 79 n $certsDir skey
0cb0: 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e 74 .pem].set client
0cc0: 4b 65 79 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 Key [file join $
0cd0: 63 65 72 74 73 44 69 72 20 63 6b 65 79 2e 70 65 certsDir ckey.pe
0ce0: 6d 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 m]..# Some tests
0cf0: 20 72 65 71 75 69 72 65 20 74 68 65 20 74 65 73 require the tes
0d00: 74 74 68 72 65 61 64 20 63 6f 6d 6d 61 6e 64 0a tthread command.
0d10: 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a .set ::tcltest::
0d20: 74 65 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 testConstraints(
0d30: 74 65 73 74 74 68 72 65 61 64 29 20 5c 0a 09 5b testthread) \..[
0d40: 65 78 70 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d expr {[info comm
0d50: 61 6e 64 73 20 74 65 73 74 74 68 72 65 61 64 5d ands testthread]
0d60: 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 49 66 != {}}]..#.# If
0d70: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
0d80: 6f 72 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 or remoteServerP
0d90: 6f 72 74 20 61 72 65 20 6e 6f 74 20 73 65 74 2c ort are not set,
0da0: 20 63 68 65 63 6b 20 69 6e 20 74 68 65 0a 23 20 check in the.#
0db0: 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 environment vari
0dc0: 61 62 6c 65 73 20 66 6f 72 20 65 78 74 65 72 6e ables for extern
0dd0: 61 6c 6c 79 20 73 65 74 20 76 61 6c 75 65 73 2e ally set values.
0de0: 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 .#..if {![info e
0df0: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
0e00: 65 72 49 50 5d 7d 20 7b 0a 20 20 20 20 69 66 20 erIP]} {. if
0e10: 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e {[info exists en
0e20: 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 v(remoteServerIP
0e30: 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 )]} {..set remot
0e40: 65 53 65 72 76 65 72 49 50 20 24 65 6e 76 28 72 eServerIP $env(r
0e50: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 0a 20 emoteServerIP).
0e60: 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 }.}.if {![inf
0e70: 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 o exists remoteS
0e80: 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 erverPort]} {.
0e90: 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 if {[info exis
0ea0: 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 ts env(remoteSer
0eb0: 76 65 72 50 6f 72 74 29 5d 7d 20 7b 0a 09 73 65 verPort)]} {..se
0ec0: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
0ed0: 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 rt $env(remoteSe
0ee0: 72 76 65 72 50 6f 72 74 29 0a 20 20 20 20 7d 20 rverPort). }
0ef0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 69 else {. i
0f00: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0f10: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 7d remoteServerIP]}
0f20: 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f {.. set remo
0f30: 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 74 6c teServerPort $tl
0f40: 73 53 65 72 76 65 72 50 6f 72 74 0a 20 20 20 20 sServerPort.
0f50: 20 20 20 20 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 23 }. }.}..#
0f60: 0a 23 20 43 68 65 63 6b 20 69 66 20 77 65 27 72 .# Check if we'r
0f70: 65 20 73 75 70 70 6f 73 65 64 20 74 6f 20 64 6f e supposed to do
0f80: 20 74 65 73 74 73 20 61 67 61 69 6e 73 74 20 74 tests against t
0f90: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
0fa0: 0a 23 0a 0a 73 65 74 20 64 6f 54 65 73 74 73 57 .#..set doTestsW
0fb0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
0fc0: 31 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 1.if {![info exi
0fd0: 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 sts remoteServer
0fe0: 49 50 5d 20 26 26 20 28 24 74 63 6c 5f 70 6c 61 IP] && ($tcl_pla
0ff0: 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 tform(platform)
1000: 21 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 29 7d != "macintosh")}
1010: 20 7b 0a 20 20 20 20 73 65 74 20 72 65 6d 6f 74 {. set remot
1020: 65 53 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e eServerIP 127.0.
1030: 30 2e 31 0a 7d 0a 69 66 20 7b 28 24 64 6f 54 65 0.1.}.if {($doTe
1040: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1050: 76 65 72 20 3d 3d 20 31 29 20 26 26 20 28 21 5b ver == 1) && (![
1060: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
1070: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 29 7d 20 teServerPort])}
1080: 7b 0a 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 {. set remote
1090: 53 65 72 76 65 72 50 6f 72 74 20 24 74 6c 73 53 ServerPort $tlsS
10a0: 65 72 76 65 72 50 6f 72 74 0a 7d 0a 0a 23 20 41 erverPort.}..# A
10b0: 74 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 ttempt to connec
10c0: 74 20 74 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 t to a remote se
10d0: 72 76 65 72 20 69 66 20 6f 6e 65 20 69 73 20 61 rver if one is a
10e0: 6c 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 lready running.
10f0: 49 66 20 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 If it.# is not r
1100: 75 6e 6e 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f unning or for so
1110: 6d 65 20 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 me other reason
1120: 74 68 65 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c the connect fail
1130: 73 2c 20 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 s, attempt to.#
1140: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
1150: 20 73 65 72 76 65 72 20 6f 6e 20 74 68 65 20 6c server on the l
1160: 6f 63 61 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e ocal host listen
1170: 69 6e 67 20 6f 6e 20 70 6f 72 74 20 38 30 34 38 ing on port 8048
1180: 2e 20 54 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 . This.# is only
1190: 20 64 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 done on platfor
11a0: 6d 73 20 74 68 61 74 20 73 75 70 70 6f 72 74 20 ms that support
11b0: 65 78 65 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f exec (i.e. not o
11c0: 6e 20 74 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 n the Mac). On.#
11d0: 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 platforms that
11e0: 64 6f 20 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 do not support e
11f0: 78 65 63 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 xec, the remote
1200: 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 73 server must be s
1210: 74 61 72 74 65 64 0a 23 20 62 79 20 74 68 65 20 tarted.# by the
1220: 75 73 65 72 20 62 65 66 6f 72 65 20 72 75 6e 6e user before runn
1230: 69 6e 67 20 74 68 65 20 74 65 73 74 73 2e 0a 0a ing the tests...
1240: 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 set remoteProcCh
1250: 61 6e 20 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e an "".set comman
1260: 64 53 6f 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 dSocket "".if {$
1270: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1280: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 eServer} {. c
1290: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d atch {close $com
12a0: 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 mandSocket}.
12b0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 if {[catch {set
12c0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 commandSocket [t
12d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
12e0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
12f0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
1300: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
1310: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
1320: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
1330: 49 50 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 IP \.. $remot
1340: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d 20 21 eServerPort]}] !
1350: 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 = 0} {..if {[inf
1360: 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d o commands exec]
1370: 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 73 == ""} {.. s
1380: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1390: 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 78 65 eason "can't exe
13a0: 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f 54 65 c".. set doTe
13b0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
13c0: 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a ver 0..} else {.
13d0: 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 . set remoteS
13e0: 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e erverIP 127.0.0.
13f0: 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 1.. set remot
1400: 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e eFile [file join
1410: 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e 74 63 [pwd] remote.tc
1420: 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 74 l].. if {[cat
1430: 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 50 72 ch {set remotePr
1440: 6f 63 43 68 61 6e 20 5c 0a 09 09 09 09 5b 6f 70 ocChan \.....[op
1450: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
1460: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 24 ltest::tcltest $
1470: 72 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 09 09 remoteFile \....
1480: 09 09 2d 73 65 72 76 65 72 49 73 53 69 6c 65 6e ..-serverIsSilen
1490: 74 20 5c 0a 09 09 09 09 09 2d 70 6f 72 74 20 24 t \......-port $
14a0: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
14b0: 20 5c 0a 09 09 09 09 09 2d 61 64 64 72 65 73 73 \......-address
14c0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
14d0: 5d 22 20 5c 0a 09 09 09 09 09 77 2b 5d 7d 20 5c ]" \......w+]} \
14e0: 0a 09 09 20 20 20 6d 73 67 5d 20 3d 3d 20 30 7d ... msg] == 0}
14f0: 20 7b 0a 09 09 61 66 74 65 72 20 31 30 30 30 0a {...after 1000.
1500: 09 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 ..if {[catch {se
1510: 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 t commandSocket
1520: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
1530: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
1540: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
1550: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
1560: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
1570: 0a 09 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 .....$remoteServ
1580: 65 72 49 50 20 5c 0a 09 09 09 09 24 72 65 6d 6f erIP \.....$remo
1590: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d teServerPort]} m
15a0: 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 sg] == 0} {...
15b0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f fconfigure $co
15c0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 mmandSocket -tra
15d0: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 nslation crlf -b
15e0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 uffering line...
15f0: 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 } else {... s
1600: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1610: 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 eason $msg...
1620: 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 set doTestsWith
1630: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 RemoteServer 0..
1640: 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b .}.. } else {
1650: 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 ...set noRemoteT
1660: 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 estReason "$msg
1670: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
1680: 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54 65 73 est"...set doTes
1690: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
16a0: 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 er 0.. }..}.
16b0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f } else {..fco
16c0: 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 nfigure $command
16d0: 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 Socket -translat
16e0: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
16f0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d ing line. }.}
1700: 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 61 ..# Some tests a
1710: 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 re run only if w
1720: 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65 73 74 e are doing test
1730: 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20 72 65 ing against a re
1740: 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 65 74 mote server..set
1750: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 ::tcltest::test
1760: 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 65 Constraints(doTe
1770: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1780: 76 65 72 29 20 24 64 6f 54 65 73 74 73 57 69 74 ver) $doTestsWit
1790: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 hRemoteServer.if
17a0: 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 {$doTestsWithRe
17b0: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 30 7d moteServer == 0}
17c0: 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 {. if {[stri
17d0: 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a 74 63 ng first s $::tc
17e0: 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 ltest::verbose]
17f0: 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 != -1} {. .pu
1800: 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74 65 73 ts "Skipping tes
1810: 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65 20 73 ts with remote s
1820: 65 72 76 65 72 2e 20 53 65 65 20 74 65 73 74 73 erver. See tests
1830: 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 /socket.test for
1840: 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 "..puts "informa
1850: 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 tion on how to r
1860: 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 un remote server
1870: 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73 6f 6e ."..puts "Reason
1880: 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 for not doing r
1890: 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 6e 6f emote tests: $no
18a0: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
18b0: 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 ". }.}..#.# I
18c0: 66 20 77 65 20 64 6f 20 74 68 65 20 74 65 73 74 f we do the test
18d0: 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d s, define a comm
18e0: 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 63 6f and to send a co
18f0: 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 mmand to the.# r
1900: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 0a emote server..#.
1910: 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 .if {$doTestsWit
1920: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d hRemoteServer ==
1930: 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 1} {. proc s
1940: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b endCommand {c} {
1950: 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 ..global command
1960: 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f Socket...if {[eo
1970: 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 f $commandSocket
1980: 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 ]} {.. error
1990: 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 "remote server d
19a0: 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a isappeared"..}..
19b0: 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 .if {[catch {put
19c0: 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 s $commandSocket
19d0: 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 $c} msg]} {..
19e0: 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 error "remote
19f0: 73 65 72 76 65 72 20 64 69 73 61 70 70 61 65 72 server disappaer
1a00: 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 ed: $msg"..}..if
1a10: 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 {[catch {puts $
1a20: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d commandSocket "-
1a30: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1a40: 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d -Marker--"} msg]
1a50: 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 } {.. error "
1a60: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 remote server di
1a70: 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 sappeared: $msg"
1a80: 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 22 ..}...set resp "
1a90: 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 "..while {1} {..
1aa0: 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 set line [ge
1ab0: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
1ac0: 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 t].. if {[eof
1ad0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
1ae0: 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 6d } {...error "rem
1af0: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
1b00: 70 65 61 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 peared".. }..
1b10: 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 if {[string
1b20: 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 2d compare $line "-
1b30: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1b40: 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 -Marker--"] == 0
1b50: 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e } {...if {[strin
1b60: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
1b70: 78 20 24 72 65 73 70 20 30 5d 20 65 72 72 6f 72 x $resp 0] error
1b80: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 ] == 0} {...
1b90: 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 error [lindex $r
1ba0: 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 esp 1]...} else
1bb0: 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b {... return [
1bc0: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a lindex $resp 1].
1bd0: 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ..}.. } else
1be0: 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 {...append resp
1bf0: 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 $line "\n"..
1c00: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 }..}. }.}..te
1c10: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 st tlsIO-1.1 {ar
1c20: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1c30: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1c40: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1c50: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1c60: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d ocket -server} m
1c70: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
1c80: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
1c90: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
1ca0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
1cb0: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
1cc0: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
1cd0: 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 O-1.2 {arg parsi
1ce0: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1cf0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1d00: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1d10: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1d20: 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d server foo} msg]
1d30: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
1d40: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
1d50: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
1d60: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
1d70: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
1d80: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
1d90: 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .3 {arg parsing
1da0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1db0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1dc0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1dd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
1de0: 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d ddr} msg] $msg.}
1df0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
1e00: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
1e10: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
1e20: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
1e30: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 34 ..test tlsIO-1.4
1e40: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
1e50: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
1e60: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
1e70: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
1e80: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 s::socket -myadd
1e90: 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 r 127.0.0.1} msg
1ea0: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
1eb0: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
1ec0: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
1ed0: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
1ee0: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
1ef0: 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 20 70 61 lsIO-1.5 {arg pa
1f00: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
1f10: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
1f20: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
1f30: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
1f40: 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 t -myport} msg]
1f50: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
1f60: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
1f70: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
1f80: 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 ?options? host p
1f90: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
1fa0: 49 4f 2d 31 2e 36 20 7b 61 72 67 20 70 61 72 73 IO-1.6 {arg pars
1fb0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
1fc0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
1fd0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
1fe0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
1ff0: 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 6d 73 -myport xxxx} ms
2000: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2010: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2020: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2030: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2040: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
2050: 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 72 67 20 70 tlsIO-1.7 {arg p
2060: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
2070: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
2080: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
2090: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
20a0: 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 32 7d et -myport 2522}
20b0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
20c0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
20d0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
20e0: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
20f0: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
2100: 73 74 20 74 6c 73 49 4f 2d 31 2e 38 20 7b 61 72 st tlsIO-1.8 {ar
2110: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2120: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2130: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2140: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2150: 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a 7d 20 6d ocket -froboz} m
2160: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2170: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2180: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2190: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
21a0: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
21b0: 20 74 6c 73 49 4f 2d 31 2e 39 20 7b 61 72 67 20 tlsIO-1.9 {arg
21c0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
21d0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
21e0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
21f0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2200: 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 20 ket -server foo
2210: 2d 6d 79 70 6f 72 74 20 32 35 32 31 20 33 33 33 -myport 2521 333
2220: 33 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 3} msg] $msg.} {
2230: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2240: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2250: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2260: 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 command ?options
2270: 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 ? port"}}..test
2280: 74 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67 20 tlsIO-1.10 {arg
2290: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
22a0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
22b0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
22c0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
22d0: 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d 6a ket host 2528 -j
22e0: 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d unk} msg] $msg.}
22f0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2300: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2310: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
2320: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
2330: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 ..test tlsIO-1.1
2340: 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 1 {arg parsing f
2350: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2360: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2370: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2380: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2390: 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 30 er callback 2520
23a0: 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d --} msg] $msg.}
23b0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
23c0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
23d0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
23e0: 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f r command ?optio
23f0: 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ns? port"}}..tes
2400: 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 72 t tlsIO-1.12 {ar
2410: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2420: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2430: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2440: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2450: 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f 72 ocket foo badpor
2460: 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b t} msg] $msg.} {
2470: 31 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74 65 1 {expected inte
2480: 67 65 72 20 62 75 74 20 67 6f 74 20 22 62 61 64 ger but got "bad
2490: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
24a0: 73 49 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e sIO-2.1 {tcp con
24b0: 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 nection} {socket
24c0: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
24d0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
24e0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
24f0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
2500: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
2510: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
2520: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
2530: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 74 er 2000 "set x t
2540: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 7d imed_out"]. }
2550: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
2560: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
2570: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
2580: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
2590: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
25a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
25b0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 $serverKey 8828
25c0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
25d0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
25e0: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
25f0: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a {.. global x.
2600: 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a . set x done.
2610: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
2620: 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 e $file..}..puts
2630: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
2640: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
2650: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 imer..close $f..
2660: 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 puts $x. }.
2670: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2680: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
2690: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
26a0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
26b0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
26c0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
26d0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 {tls::socket -ce
26e0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
26f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2700: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
2710: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
2720: 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 0.1 8828} msg]}
2730: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
2740: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
2750: 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e {. lappen
2760: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
2770: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 close $msg
2780: 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 . }. lappe
2790: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
27a0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
27b0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
27c0: 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 one {}}..if [inf
27d0: 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 20 7b o exists port] {
27e0: 0a 20 20 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d . incr port.}
27f0: 20 65 6c 73 65 20 7b 20 0a 20 20 20 20 73 65 74 else { . set
2800: 20 70 6f 72 74 20 5b 65 78 70 72 20 24 74 6c 73 port [expr $tls
2810: 53 65 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 ServerPort + [pi
2820: 64 5d 25 31 30 32 34 5d 0a 7d 0a 0a 74 65 73 74 d]%1024].}..test
2830: 20 74 6c 73 49 4f 2d 32 2e 32 20 7b 74 63 70 20 tlsIO-2.2 {tcp
2840: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
2850: 63 6c 69 65 6e 74 20 70 6f 72 74 20 73 70 65 63 client port spec
2860: 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 ified} {socket s
2870: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
2880: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
2890: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
28a0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
28b0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
28c0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
28d0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
28e0: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
28f0: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
2900: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
2910: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
2920: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
2930: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
2940: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
2950: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
2960: 38 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 74 8829 \]". put
2970: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
2980: 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 ept {sock addr p
2990: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
29a0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
29b0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
29c0: 65 74 73 20 24 73 6f 63 6b 5d 20 24 70 6f 72 74 ets $sock] $port
29d0: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
29e0: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ose $sock.
29f0: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
2a00: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
2a10: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
2a20: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
2a30: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
2a40: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2a50: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
2a60: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
2a70: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
2a80: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
2a90: 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 74 . global port
2aa0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
2ab0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
2ac0: 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a 09 2d 63 port $port \..-c
2ad0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
2ae0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
2af0: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
2b00: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
2b10: 2e 30 2e 31 20 38 38 32 39 7d 20 73 6f 63 6b 5d .0.1 8829} sock]
2b20: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
2b30: 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 7b x $sock..catch {
2b40: 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b close [tls::sock
2b50: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 et 127.0.0.1 882
2b60: 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 9]}. } else {
2b70: 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 . puts $s
2b80: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 ock hello..flush
2b90: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c $sock. l
2ba0: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
2bb0: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
2bc0: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
2bd0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2be0: 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 61 64 t x.} [list read
2bf0: 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 22 5d y "hello $port"]
2c00: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 33 ..test tlsIO-2.3
2c10: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
2c20: 20 77 69 74 68 20 63 6c 69 65 6e 74 20 69 6e 74 with client int
2c30: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
2c40: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
2c50: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
2c60: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
2c70: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
2c80: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
2c90: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
2ca0: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
2cb0: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
2cc0: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
2cd0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
2ce0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
2cf0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
2d00: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
2d10: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
2d20: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
2d30: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 30 20 $serverKey 8830
2d40: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
2d50: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
2d60: 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 sock addr port}
2d70: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
2d80: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
2d90: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
2da0: 73 6f 63 6b 5d 20 24 61 64 64 72 22 0a 20 20 20 sock] $addr".
2db0: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
2dc0: 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 sock.
2dd0: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
2de0: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
2df0: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
2e00: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
2e10: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
2e20: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
2e30: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
2e40: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
2e50: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
2e60: 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 gets $f x.
2e70: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
2e80: 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 :socket -myaddr
2e90: 31 32 37 2e 30 2e 30 2e 31 20 5c 0a 09 2d 63 65 127.0.0.1 \..-ce
2ea0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
2eb0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2ec0: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
2ed0: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
2ee0: 30 2e 31 20 38 38 33 30 7d 20 73 6f 63 6b 5d 7d 0.1 8830} sock]}
2ef0: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
2f00: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 $sock. } els
2f10: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
2f20: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 $sock hello..ca
2f30: 74 63 68 20 7b 66 6c 75 73 68 20 24 73 6f 63 6b tch {flush $sock
2f40: 7d 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e }. lappen
2f50: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
2f60: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 close $soc
2f70: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 k. }. clos
2f80: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
2f90: 20 7b 72 65 61 64 79 20 7b 68 65 6c 6c 6f 20 31 {ready {hello 1
2fa0: 32 37 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 27.0.0.1}}..test
2fb0: 20 74 6c 73 49 4f 2d 32 2e 34 20 7b 74 63 70 20 tlsIO-2.4 {tcp
2fc0: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
2fd0: 73 65 72 76 65 72 20 69 6e 74 65 72 66 61 63 65 server interface
2fe0: 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 specified} {soc
2ff0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3000: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
3010: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
3020: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
3030: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
3040: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
3050: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
3060: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f r 2000 "set x do
3070: 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ne"]. }. p
3080: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3090: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
30a0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
30b0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
30c0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
30d0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
30e0: 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 5b 69 6e rKey -myaddr [in
30f0: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 fo hostname] 883
3100: 31 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 1 \]". puts $
3110: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
3120: 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 {sock addr port
3130: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
3140: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
3150: 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 puts "[gets
3160: 20 24 73 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 $sock]".
3170: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
3180: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
3190: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
31a0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
31b0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
31c0: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
31d0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
31e0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
31f0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3200: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3210: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
3220: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
3230: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
3240: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
3250: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3260: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
3270: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
3280: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
3290: 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 8831} sock]} {.
32a0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 set x $s
32b0: 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ock. } else {
32c0: 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 . puts $s
32d0: 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 ock hello..flush
32e0: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c $sock. l
32f0: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
3300: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
3310: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
3320: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
3330: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c t x.} {ready hel
3340: 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d lo}..test tlsIO-
3350: 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.5 {tcp connect
3360: 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e 64 61 ion with redunda
3370: 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 7d 20 nt server port}
3380: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
3390: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
33a0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
33b0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
33c0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
33d0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
33e0: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
33f0: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
3400: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 x done"]. }.
3410: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
3420: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
3430: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
3440: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
3450: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3460: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
3470: 65 72 76 65 72 4b 65 79 20 38 38 33 32 20 5c 5d erverKey 8832 \]
3480: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
3490: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f .proc accept {so
34a0: 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a ck addr port} {.
34b0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
34c0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
34d0: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f puts "[gets $so
34e0: 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 ck]".
34f0: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3500: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
3510: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
3520: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3530: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3540: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
3550: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3560: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3570: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3580: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3590: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
35a0: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
35b0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
35c0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
35d0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
35e0: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
35f0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
3600: 2e 30 2e 30 2e 31 20 38 38 33 32 7d 20 73 6f 63 .0.0.1 8832} soc
3610: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 k]} {. se
3620: 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 t x $sock. }
3630: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 else {. p
3640: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a uts $sock hello.
3650: 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 .flush $sock.
3660: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b lappend x [
3670: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 gets $f].
3680: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3690: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
36a0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
36b0: 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 dy hello}.test t
36c0: 6c 73 49 4f 2d 32 2e 36 20 7b 74 63 70 20 63 6f lsIO-2.6 {tcp co
36d0: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
36e0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 t} {. set sta
36f0: 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 tus ok. if {!
3700: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 6f 63 6b [catch {set sock
3710: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
3720: 37 2e 30 2e 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 7.0.0.1 8833]}]}
3730: 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 {..if {![catch
3740: 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b {gets $sock}]} {
3750: 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 75 73 .. set status
3760: 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 broken..}..clos
3770: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
3780: 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f set status.} o
3790: 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e k..test tlsIO-2.
37a0: 37 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 7 {echo server,
37b0: 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 one line} {socke
37c0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
37d0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
37e0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
37f0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
3800: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
3810: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
3820: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
3830: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
3840: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
3850: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
3860: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
3870: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
3880: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
3890: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
38a0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
38b0: 65 79 20 38 38 33 34 20 5c 5d 22 0a 20 20 20 20 ey 8834 \]".
38c0: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
38d0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
38e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
38f0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
3900: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
3910: 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ].. fconfigur
3920: 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $s -translatio
3930: 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 n lf -buffering
3940: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
3950: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
3960: 09 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 . set l [get
3970: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 s $s].
3980: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
3990: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
39a0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
39b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c cl
39c0: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
39d0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
39e0: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ne.
39f0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
3a00: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
3a10: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
3a20: 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 }..}..puts rea
3a30: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3a40: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3a50: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
3a60: 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 done. }.
3a70: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3a80: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
3a90: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
3aa0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
3ab0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
3ac0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
3ad0: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
3ae0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3af0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
3b00: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
3b10: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 34 5d 127.0.0.1 8834]
3b20: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
3b30: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
3b40: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
3b50: 6c 66 0a 20 20 20 20 70 75 74 73 20 24 73 20 22 lf. puts $s "
3b60: 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a hello abcdefghij
3b70: 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 66 74 65 klmnop". afte
3b80: 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 78 r 1000. set x
3b90: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
3ba0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
3bb0: 79 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 y [gets $f].
3bc0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 6c 69 73 close $f. lis
3bd0: 74 20 24 78 20 24 79 0a 7d 20 7b 7b 68 65 6c 6c t $x $y.} {{hell
3be0: 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e o abcdefghijklmn
3bf0: 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 op} done}..test
3c00: 74 6c 73 49 4f 2d 32 2e 38 20 7b 65 63 68 6f 20 tlsIO-2.8 {echo
3c10: 73 65 72 76 65 72 2c 20 6c 6f 6f 70 20 35 30 20 server, loop 50
3c20: 74 69 6d 65 73 2c 20 73 69 6e 67 6c 65 20 63 6f times, single co
3c30: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
3c40: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 t stdio} {. s
3c50: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
3c60: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
3c70: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
3c80: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
3c90: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3ca0: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3cb0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3cc0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
3cd0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
3ce0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
3cf0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 $serverKey 8835
3d00: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
3d10: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
3d20: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 {s a p} {.
3d30: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
3d40: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
3d50: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 t echo $s].
3d60: 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 fconfigur
3d70: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
3d80: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
3d90: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
3da0: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 . global i.
3db0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
3dc0: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
3dd0: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
3de0: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
3df0: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
3e00: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
3e10: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
3e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 se
3e30: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
3e40: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a } else { .
3e50: 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 . incr i
3e60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3e70: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
3e80: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
3e90: 73 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 65 set i 0..puts re
3ea0: 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b ady..set timer [
3eb0: 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 after 20000 "set
3ec0: 20 78 20 64 6f 6e 65 22 5d 0a 09 76 77 61 69 74 x done"]..vwait
3ed0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3ee0: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3ef0: 66 0a 09 70 75 74 73 20 22 64 6f 6e 65 20 24 69 f..puts "done $i
3f00: 22 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 ". }. clos
3f10: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3f20: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3f30: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3f40: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3f50: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
3f60: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
3f70: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
3f80: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
3f90: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
3fa0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
3fb0: 2e 30 2e 30 2e 31 20 38 38 33 35 5d 0a 20 20 20 .0.0.1 8835].
3fc0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
3fd0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
3fe0: 20 20 20 63 61 74 63 68 20 7b 0a 09 66 6f 72 20 catch {..for
3ff0: 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 20 3c 20 {set x 0} {$x <
4000: 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 50} {incr x} {..
4010: 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 6c puts $s "hel
4020: 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d lo abcdefghijklm
4030: 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 73 20 24 nop".. gets $
4040: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 s..}. }. c
4050: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 61 74 63 lose $s. catc
4060: 68 20 7b 73 65 74 20 78 20 5b 67 65 74 73 20 24 h {set x [gets $
4070: 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 f]}. close $f
4080: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 64 6f . set x.} {do
4090: 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 74 6c 73 ne 50}..test tls
40a0: 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20 63 IO-2.9 {socket c
40b0: 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 onflict} {socket
40c0: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 stdio} {. se
40d0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
40e0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
40f0: 38 38 32 38 5d 0a 20 20 20 20 72 65 6d 6f 76 65 8828]. remove
4100: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
4110: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
4120: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 2d pt w]. puts -
4130: 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 7b 70 61 nonewline $f {pa
4140: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
4150: 73 3b 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s; tls::socket -
4160: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
4170: 32 38 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 28}. close $f
4180: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4190: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
41a0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
41b0: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
41c0: 73 20 24 66 0a 20 20 20 20 61 66 74 65 72 20 31 s $f. after 1
41d0: 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 00. set x [li
41e0: 73 74 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 st [catch {close
41f0: 20 24 66 7d 20 6d 73 67 5d 20 24 6d 73 67 5d 0a $f} msg] $msg].
4200: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
4210: 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 set x.} {1 {cou
4220: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
4230: 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 t: address alrea
4240: 64 79 20 69 6e 20 75 73 65 0a 20 20 20 20 77 68 dy in use. wh
4250: 69 6c 65 20 65 78 65 63 75 74 69 6e 67 0a 22 3a ile executing.":
4260: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4270: 7b 74 6c 73 3a 3a 5f 61 63 63 65 70 74 20 7b 2d {tls::_accept {-
4280: 73 65 72 76 65 72 20 31 7d 20 61 63 63 65 70 74 server 1} accept
4290: 7d 20 38 38 32 38 22 0a 20 20 20 20 28 22 65 76 } 8828". ("ev
42a0: 61 6c 22 20 62 6f 64 79 20 6c 69 6e 65 20 31 29 al" body line 1)
42b0: 0a 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f . invoked fro
42c0: 6d 20 77 69 74 68 69 6e 0a 22 65 76 61 6c 20 3a m within."eval :
42d0: 3a 73 6f 63 6b 65 74 20 24 73 6f 70 74 73 22 0a :socket $sopts".
42e0: 20 20 20 20 28 70 72 6f 63 65 64 75 72 65 20 22 (procedure "
42f0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 22 20 6c 69 6e tls::socket" lin
4300: 65 20 36 32 29 0a 20 20 20 20 69 6e 76 6f 6b 65 e 62). invoke
4310: 64 20 66 72 6f 6d 20 77 69 74 68 69 6e 0a 22 74 d from within."t
4320: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4330: 65 72 20 61 63 63 65 70 74 20 38 38 32 38 22 0a er accept 8828".
4340: 20 20 20 20 28 66 69 6c 65 20 22 73 63 72 69 70 (file "scrip
4350: 74 22 20 6c 69 6e 65 20 31 29 7d 7d 0a 0a 74 65 t" line 1)}}..te
4360: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 st tlsIO-2.10 {c
4370: 6c 6f 73 65 20 6f 6e 20 61 63 63 65 70 74 2c 20 lose on accept,
4380: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 accepted socket
4390: 6c 69 76 65 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 lives} {socket}
43a0: 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 {. set done 0
43b0: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
43c0: 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 after 20000 "set
43d0: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
43e0: 5d 0a 20 20 20 20 73 65 74 20 73 73 20 5b 74 6c ]. set ss [tl
43f0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4400: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
4410: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
4420: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4430: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 ..-keyfile $serv
4440: 65 72 4b 65 79 20 38 38 33 30 5d 0a 20 20 20 20 erKey 8830].
4450: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
4460: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 p} {..global ss
4470: 0a 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c ..close $ss..fil
4480: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
4490: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 09 le "readit $s"..
44a0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
44b0: 72 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 rans lf. }.
44c0: 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 proc readit {s
44d0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 } {..global done
44e0: 0a 09 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 ..gets $s..close
44f0: 20 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a $s..set done 1.
4500: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 73 }. set cs
4510: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
4520: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
4530: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4540: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4550: 24 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f $clientKey [info
4560: 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 30 5d hostname] 8830]
4570: 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a 0a . close $cs..
4580: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
4590: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
45a0: 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 20 64 $timer. set d
45b0: 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c one.} 1..test tl
45c0: 73 49 4f 2d 32 2e 31 31 20 7b 64 65 74 65 63 74 sIO-2.11 {detect
45d0: 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 7b 73 ing new data} {s
45e0: 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 7d 20 ocket knownBug}
45f0: 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 68 {. # HOBBS: h
4600: 75 6e 67 20 70 72 65 2d 72 65 77 72 69 74 65 2c ung pre-rewrite,
4610: 20 68 61 6e 67 73 20 70 6f 73 74 2d 72 65 77 72 hangs post-rewr
4620: 69 74 65 0a 20 20 20 20 70 72 6f 63 20 61 63 63 ite. proc acc
4630: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
4640: 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 73 65 74 20 lobal sock..set
4650: 73 6f 63 6b 20 24 73 0a 09 73 65 74 20 66 20 5b sock $s..set f [
4660: 6f 70 65 6e 20 61 77 62 2e 6c 6f 67 20 77 5d 0a open awb.log w].
4670: 09 70 75 74 73 20 24 66 20 5b 63 61 74 63 68 20 .puts $f [catch
4680: 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 {tls::handshake
4690: 24 73 6f 63 6b 7d 20 65 72 72 5d 0a 09 70 75 74 $sock} err]..put
46a0: 73 20 24 66 20 22 65 72 72 3a 20 24 65 72 72 22 s $f "err: $err"
46b0: 0a 09 70 75 74 73 20 24 66 20 22 5b 74 6c 73 3a ..puts $f "[tls:
46c0: 3a 73 74 61 74 75 73 20 24 73 6f 63 6b 5d 22 0a :status $sock]".
46d0: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
46e0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
46f0: 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 :socket -require
4700: 20 30 20 2d 72 65 71 75 65 73 74 20 30 20 2d 73 0 -request 0 -s
4710: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
4720: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
4730: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4740: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4750: 73 65 72 76 65 72 4b 65 79 20 38 34 30 30 5d 0a serverKey 8400].
4760: 20 20 20 20 73 65 74 20 73 6f 63 6b 20 22 22 0a set sock "".
4770: 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a set s2 [tls:
4780: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
4790: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
47a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
47b0: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
47c0: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
47d0: 34 30 30 5d 0a 20 20 20 20 76 77 61 69 74 20 73 400]. vwait s
47e0: 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 ock. puts $s2
47f0: 20 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 one. flush $
4800: 73 32 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 s2. after 500
4810: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4820: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
4830: 30 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0. set result
4840: 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 [gets $sock].
4850: 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 lappend result
4860: 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 [gets $sock].
4870: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
4880: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 ck -blocking 1.
4890: 20 20 20 70 75 74 73 20 24 73 32 20 74 77 6f 0a puts $s2 two.
48a0: 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 flush $s2.
48b0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
48c0: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 ck -blocking 0.
48d0: 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c lappend resul
48e0: 74 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 t [gets $sock].
48f0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
4900: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a ock -blocking 1.
4910: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
4920: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
4930: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 lose $sock. s
4940: 65 74 20 72 65 73 75 6c 74 0a 7d 20 7b 6f 6e 65 et result.} {one
4950: 20 7b 7d 20 74 77 6f 7d 0a 0a 74 65 73 74 20 74 {} two}..test t
4960: 6c 73 49 4f 2d 32 2e 31 32 20 7b 74 63 70 20 63 lsIO-2.12 {tcp c
4970: 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 onnection; no ce
4980: 72 74 69 66 69 63 61 74 65 73 20 73 70 65 63 69 rtificates speci
4990: 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 fied} {socket st
49a0: 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 dio pcCrash} {.
49b0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
49c0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
49d0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
49e0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
49f0: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
4a00: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
4a10: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
4a20: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
4a30: 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 .set f [tls::soc
4a40: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
4a50: 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 pt 8828]..proc a
4a60: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
4a70: 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c port} {.. gl
4a80: 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 obal x.. set
4a90: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
4aa0: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
4ab0: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
4ac0: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
4ad0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
4ae0: 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 se $f..puts $x.
4af0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
4b00: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
4b10: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
4b20: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
4b30: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
4b40: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
4b50: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
4b60: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 ket 127.0.0.1 88
4b70: 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 28} msg]} {.
4b80: 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 set x $msg.
4b90: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
4ba0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
4bb0: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
4bc0: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
4bd0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b . lappend x [
4be0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
4bf0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
4c00: 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d } {ready done {}
4c10: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e }..test tlsIO-3.
4c20: 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 1 {socket confli
4c30: 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ct} {socket stdi
4c40: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
4c50: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
4c60: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
4c70: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
4c80: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
4c90: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
4ca0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
4cb0: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
4cc0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4cd0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
4ce0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
4cf0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
4d00: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 $serverKey 8828
4d10: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
4d20: 20 7b 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 {..puts ready..
4d30: 67 65 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 gets stdin..clos
4d40: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
4d50: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4d60: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
4d70: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
4d80: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
4d90: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
4da0: 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 set x [list [ca
4db0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
4dc0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
4dd0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
4de0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
4df0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
4e00: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
4e10: 20 61 63 63 65 70 74 20 38 38 32 38 7d 20 6d 73 accept 8828} ms
4e20: 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 g] \...$msg].
4e30: 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 puts $f bye.
4e40: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4e50: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
4e60: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
4e70: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
4e80: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 in use}}..test t
4e90: 6c 73 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 lsIO-3.2 {server
4ea0: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
4eb0: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
4ec0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
4ed0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
4ee0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
4ef0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
4f00: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
4f10: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
4f20: 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 set t1 [after 30
4f30: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
4f40: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 32 20 5b _out"]..set t2 [
4f50: 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 after 31000 "set
4f60: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 x timed_out"]..
4f70: 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 set t3 [after 32
4f80: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
4f90: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 63 6f 75 6e _out"]..set coun
4fa0: 74 65 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 ter 0. }.
4fb0: 70 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c puts $f "set s \
4fc0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
4fd0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
4fe0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
4ff0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5000: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
5010: 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 erKey 8828 \]".
5020: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
5030: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
5040: 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 } {.. fileeve
5050: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
5060: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 list echo $s]..
5070: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5080: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5090: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
50a0: 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 s} {.. globa
50b0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
50c0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
50d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 . if
50e0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
50f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
5100: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
5110: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
5120: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
5130: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
5140: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
5150: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
5160: 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 }..}..puts re
5170: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
5180: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 09 ter cancel $t1..
5190: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
51a0: 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 61 69 74 ancel $t2..vwait
51b0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
51c0: 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 73 0a 09 $t3..close $s..
51d0: 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 puts $x. }.
51e0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
51f0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
5200: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
5210: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
5220: 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 5b 67 r+]. set x [g
5230: 65 74 73 20 24 66 5d 0a 20 20 20 20 73 65 74 20 ets $f]. set
5240: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
5250: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
5260: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
5270: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5280: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
5290: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
52a0: 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 8828]. fcon
52b0: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 figure $s1 -buff
52c0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
52d0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
52e0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
52f0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
5300: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
5310: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
5320: 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 Key \.. 127.0
5330: 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 .0.1 8828]. f
5340: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 configure $s2 -b
5350: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
5360: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
5370: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
5380: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
5390: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
53a0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
53b0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
53c0: 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 7.0.0.1 8828].
53d0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 fconfigure $s3
53e0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
53f0: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
5400: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
5410: 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 ncr i} {..puts $
5420: 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 s1 hello,s1..get
5430: 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 s $s1..puts $s2
5440: 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 hello,s2..gets $
5450: 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c s2..puts $s3 hel
5460: 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a lo,s3..gets $s3.
5470: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
5480: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
5490: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
54a0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
54b0: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
54c0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
54d0: 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 {ready done}..t
54e0: 65 73 74 20 74 6c 73 49 4f 2d 34 2e 31 20 7b 73 est tlsIO-4.1 {s
54f0: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
5500: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 al clients} {soc
5510: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
5520: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
5530: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
5540: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
5550: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
5560: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
5570: 74 6c 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a tls..gets stdin.
5580: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
5590: 66 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a f "set s \[tls::
55a0: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
55b0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
55c0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
55d0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
55e0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 20 127.0.0.1 8828
55f0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
5600: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
5610: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5620: 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 ..for {set i 0}
5630: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
5640: 20 69 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 i} {.. puts
5650: 24 73 20 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 $s hello.. ge
5660: 74 73 20 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 ts $s..}..close
5670: 24 73 0a 09 70 75 74 73 20 62 79 65 0a 09 67 65 $s..puts bye..ge
5680: 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 ts stdin. }.
5690: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
56a0: 73 65 74 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b set p1 [open "|[
56b0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
56c0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
56d0: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
56e0: 67 75 72 65 20 24 70 31 20 2d 62 75 66 66 65 72 gure $p1 -buffer
56f0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
5700: 20 70 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 p2 [open "|[lis
5710: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
5720: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
5730: 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 +]. fconfigur
5740: 65 20 24 70 32 20 2d 62 75 66 66 65 72 69 6e 67 e $p2 -buffering
5750: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 33 line. set p3
5760: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5770: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5780: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5790: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
57a0: 70 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p3 -buffering li
57b0: 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 ne. proc acce
57c0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
57d0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
57e0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c fering line..fil
57f0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
5800: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
5810: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 ]. }. proc
5820: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f echo {s} {..glo
5830: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 73 65 bal x. se
5840: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
5850: 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 if {[eof $
5860: 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 s]} {.
5870: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
5880: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
5890: 65 0a 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 e. } else
58a0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 {. p
58b0: 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 uts $s $l.
58c0: 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 }. }. se
58d0: 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 t t1 [after 3000
58e0: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
58f0: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 32 20 ut"]. set t2
5900: 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 [after 31000 "se
5910: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
5920: 20 20 20 20 73 65 74 20 74 33 20 5b 61 66 74 65 set t3 [afte
5930: 72 20 33 32 30 30 30 20 22 73 65 74 20 78 20 74 r 32000 "set x t
5940: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
5950: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
5960: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
5970: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
5980: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
5990: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
59a0: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
59b0: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 20 r accept 8828].
59c0: 20 20 20 70 75 74 73 20 24 70 31 20 6f 70 65 6e puts $p1 open
59d0: 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 6f 70 . puts $p2 op
59e0: 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 en. puts $p3
59f0: 6f 70 65 6e 0a 20 20 20 20 76 77 61 69 74 20 78 open. vwait x
5a00: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
5a10: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
5a20: 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 20 20 er cancel $t1.
5a30: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
5a40: 74 32 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e t2. after can
5a50: 63 65 6c 20 24 74 33 0a 20 20 20 20 63 6c 6f 73 cel $t3. clos
5a60: 65 20 24 73 0a 20 20 20 20 73 65 74 20 6c 20 22 e $s. set l "
5a70: 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ". lappend l
5a80: 5b 6c 69 73 74 20 70 31 20 5b 67 65 74 73 20 24 [list p1 [gets $
5a90: 70 31 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 p1] $x]. lapp
5aa0: 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 32 20 5b end l [list p2 [
5ab0: 67 65 74 73 20 24 70 32 5d 20 24 78 5d 0a 20 20 gets $p2] $x].
5ac0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
5ad0: 74 20 70 33 20 5b 67 65 74 73 20 24 70 33 5d 20 t p3 [gets $p3]
5ae0: 24 78 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31 $x]. puts $p1
5af0: 20 62 79 65 0a 20 20 20 20 70 75 74 73 20 24 70 bye. puts $p
5b00: 32 20 62 79 65 0a 20 20 20 20 70 75 74 73 20 24 2 bye. puts $
5b10: 70 33 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 p3 bye. close
5b20: 20 24 70 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 $p1. close $
5b30: 70 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 33 p2. close $p3
5b40: 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 . set l.} {{p
5b50: 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 32 20 1 bye done} {p2
5b60: 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 20 62 79 bye done} {p3 by
5b70: 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 e done}}..test t
5b80: 6c 73 49 4f 2d 34 2e 32 20 7b 62 79 74 65 20 6f lsIO-4.2 {byte o
5b90: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
5ba0: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
5bb0: 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b tons} {socket} {
5bc0: 0a 20 20 20 20 73 65 74 20 78 20 6f 6b 0a 20 20 . set x ok.
5bd0: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
5be0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5bf0: 72 20 64 6f 64 6f 20 30 78 33 30 30 30 7d 20 6d r dodo 0x3000} m
5c00: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 6d sg]} {..set x $m
5c10: 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a sg. } else {.
5c20: 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 .close $msg.
5c30: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 6f 6b }. set x.} ok
5c40: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 31 ..test tlsIO-5.1
5c50: 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f {byte order pro
5c60: 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 blems, socket nu
5c70: 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a mbers, htons} \.
5c80: 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c .{socket unixOnl
5c90: 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 y notRoot} {.
5ca0: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 set x {couldn't
5cb0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
5cc0: 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 t owner}. if
5cd0: 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {![catch {tls::s
5ce0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
5cf0: 64 6f 20 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a do 0x1} msg]} {.
5d00: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 7b 68 set x {h
5d10: 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 tons problem, sh
5d20: 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 ould be disallow
5d30: 65 64 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e ed, are you runn
5d40: 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f ing as SU?}..clo
5d50: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
5d60: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 set x.} {could
5d70: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
5d80: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74 not owner}.test
5d90: 20 74 6c 73 49 4f 2d 35 2e 32 20 7b 62 79 74 65 tlsIO-5.2 {byte
5da0: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
5db0: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
5dc0: 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d htons} {socket}
5dd0: 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f {. set x {co
5de0: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5df0: 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 et: port number
5e00: 74 6f 6f 20 68 69 67 68 7d 0a 20 20 20 20 69 66 too high}. if
5e10: 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a {![catch {tls::
5e20: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 socket -server d
5e30: 6f 64 6f 20 30 78 31 30 30 30 30 7d 20 6d 73 67 odo 0x10000} msg
5e40: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 ]} {..set x {por
5e50: 74 20 72 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f t resolution pro
5e60: 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 blem, should be
5e70: 64 69 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f disallowed}..clo
5e80: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
5e90: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 set x.} {could
5ea0: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
5eb0: 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f port number too
5ec0: 20 68 69 67 68 7d 0a 74 65 73 74 20 74 6c 73 49 high}.test tlsI
5ed0: 4f 2d 35 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 O-5.3 {byte orde
5ee0: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
5ef0: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
5f00: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e s} \..{socket un
5f10: 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 ixOnly notRoot}
5f20: 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 {. set x {cou
5f30: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
5f40: 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 t: not owner}.
5f50: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 if {![catch {t
5f60: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
5f70: 65 72 20 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d er dodo 21} msg]
5f80: 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e } {..set x {hton
5f90: 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c s problem, shoul
5fa0: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c d be disallowed,
5fb0: 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 are you running
5fc0: 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 as SU?}..close
5fd0: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
5fe0: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
5ff0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
6000: 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 20 74 t owner}..test t
6010: 6c 73 49 4f 2d 36 2e 31 20 7b 61 63 63 65 70 74 lsIO-6.1 {accept
6020: 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d callback error}
6030: 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 {unexplainedFai
6040: 6c 75 72 65 20 73 6f 63 6b 65 74 20 73 74 64 69 lure socket stdi
6050: 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 o pcCrash} {.
6060: 20 23 20 48 4f 42 42 53 3a 20 73 74 69 6c 6c 20 # HOBBS: still
6070: 66 61 69 6c 73 20 70 6f 73 74 2d 72 65 77 72 69 fails post-rewri
6080: 74 65 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c te. removeFil
6090: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
60a0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
60b0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
60c0: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
60d0: 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 quire tls..gets
60e0: 73 74 64 69 6e 0a 09 74 6c 73 3a 3a 73 6f 63 6b stdin..tls::sock
60f0: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 34 et 127.0.0.1 884
6100: 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 8. }. clos
6110: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
6120: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
6130: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
6140: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
6150: 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 proc bgerror a
6160: 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a rgs {..global x.
6170: 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 .set x $args.
6180: 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 }. proc acce
6190: 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 pt {s a p} {expr
61a0: 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 10 / 0}. set
61b0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
61c0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
61d0: 38 34 38 5d 0a 20 20 20 20 70 75 74 73 20 24 66 848]. puts $f
61e0: 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 hello. close
61f0: 20 24 66 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $f. set time
6200: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
6210: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
6220: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
6230: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
6240: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
6250: 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 $s. rename bg
6260: 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 error {}. set
6270: 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 x.} {{divide by
6280: 20 7a 65 72 6f 7d 7d 0a 0a 23 20 62 75 67 20 72 zero}}..# bug r
6290: 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e eport #5812 fcon
62a0: 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 figure doesn't r
62b0: 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 eturn value for
62c0: 27 2d 70 65 65 72 6e 61 6d 65 27 0a 0a 74 65 73 '-peername'..tes
62d0: 74 20 74 6c 73 49 4f 2d 37 2e 31 20 7b 74 65 73 t tlsIO-7.1 {tes
62e0: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
62f0: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 ific options} {s
6300: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
6310: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
6320: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
6330: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
6340: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
6350: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
6360: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
6370: 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 $f "tls::socket
6380: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
6390: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
63a0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
63b0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
63c0: 73 65 72 76 65 72 4b 65 79 20 38 38 32 30 22 0a serverKey 8820".
63d0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
63e0: 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 roc accept args
63f0: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a {.. global x.
6400: 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a . set x done.
6410: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
6420: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6430: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6440: 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 med_out"]..vwait
6450: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
6460: 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 $timer. }.
6470: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
6480: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
6490: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
64a0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
64b0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
64c0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
64d0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
64e0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
64f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6500: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
6510: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
6520: 37 2e 30 2e 30 2e 31 20 38 38 32 30 5d 0a 20 20 7.0.0.1 8820].
6530: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
6540: 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 ure $s -peername
6550: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
6560: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6570: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
6580: 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 pend l [string c
6590: 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 ompare [lindex $
65a0: 70 20 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a p 0] 127.0.0.1].
65b0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 lappend l [s
65c0: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c tring compare [l
65d0: 69 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 30 index $p 2] 8820
65e0: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
65f0: 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 7b [llength $p].} {
6600: 30 20 30 20 33 7d 0a 0a 23 20 62 75 67 20 72 65 0 0 3}..# bug re
6610: 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 port #5812 fconf
6620: 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 igure doesn't re
6630: 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 turn value for '
6640: 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 -sockname'..test
6650: 20 74 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 73 74 tlsIO-7.2 {test
6660: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
6670: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
6680: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
6690: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
66a0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
66b0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
66c0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
66d0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
66e0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
66f0: 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 $f "tls::socket
6700: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
6710: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
6720: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6730: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6740: 65 72 76 65 72 4b 65 79 20 38 38 32 31 22 0a 20 erverKey 8821".
6750: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
6760: 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b oc accept args {
6770: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
6780: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
6790: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 }..puts ready..s
67a0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
67b0: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
67c0: 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 ed_out"]..vwait
67d0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
67e0: 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 $timer. }.
67f0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6800: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
6810: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
6820: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
6830: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
6840: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6850: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
6860: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
6870: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6880: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
6890: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
68a0: 2e 30 2e 30 2e 31 20 38 38 32 31 5d 0a 20 20 20 .0.0.1 8821].
68b0: 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 set p [fconfigu
68c0: 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d re $s -sockname]
68d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
68e0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
68f0: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
6900: 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 end l [llength $
6910: 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c p]. lappend l
6920: 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a 20 [lindex $p 0].
6930: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
6940: 72 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 6e 64 ring equal [lind
6950: 65 78 20 24 70 20 32 5d 20 38 38 32 31 5d 0a 7d ex $p 2] 8821].}
6960: 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d {3 127.0.0.1 0}
6970: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 33 ..test tlsIO-7.3
6980: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
6990: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
69a0: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
69b0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
69c0: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
69d0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
69e0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
69f0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
6a00: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
6a10: 20 61 63 63 65 70 74 20 38 38 32 32 5d 0a 20 20 accept 8822].
6a20: 20 20 73 65 74 20 6c 20 5b 66 63 6f 6e 66 69 67 set l [fconfig
6a30: 75 72 65 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ure $s]. clos
6a40: 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a e $s. update.
6a50: 20 20 20 20 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d llength $l.}
6a60: 20 31 32 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 12..# bug repor
6a70: 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 t #5812 fconfigu
6a80: 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 re doesn't retur
6a90: 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f n value for '-so
6aa0: 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c ckname'..test tl
6ab0: 73 49 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 sIO-7.4 {testing
6ac0: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
6ad0: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
6ae0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b t} {. set s [
6af0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
6b00: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
6b10: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6b20: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6b30: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
6b40: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
6b50: 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 823]. proc ac
6b60: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
6b70: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
6b80: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
6b90: 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 sockname]..close
6ba0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
6bb0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
6bc0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
6bd0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
6be0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6bf0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
6c00: 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 . .[info host
6c10: 6e 61 6d 65 5d 20 38 38 32 33 5d 0a 20 20 20 20 name] 8823].
6c20: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6c30: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6c40: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6c50: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6c60: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6c70: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
6c80: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
6c90: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
6ca0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 d l [lindex $x 2
6cb0: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d ] [llength $x].}
6cc0: 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 {8823 3}..# bug
6cd0: 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 report #5812 fc
6ce0: 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 onfigure doesn't
6cf0: 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f return value fo
6d00: 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 r '-sockname'..t
6d10: 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 est tlsIO-7.5 {t
6d20: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
6d30: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
6d40: 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 63 {socket unixOrPc
6d50: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
6d60: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
6d70: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
6d80: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
6d90: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
6da0: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d rverKey \. .-
6db0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
6dc0: 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 29]. proc acc
6dd0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
6de0: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b lobal x..set x [
6df0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
6e00: 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 ockname]..close
6e10: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 $s. }. set
6e20: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
6e30: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
6e40: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
6e50: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
6e60: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
6e70: 20 20 20 20 09 31 32 37 2e 30 2e 30 2e 31 20 38 .127.0.0.1 8
6e80: 38 32 39 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 829]. set tim
6e90: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
6ea0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
6eb0: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 "]. vwait x.
6ec0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
6ed0: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
6ee0: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
6ef0: 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 1. set l "".
6f00: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
6f10: 6e 64 65 78 20 24 78 20 30 5d 20 5b 6c 69 6e 64 ndex $x 0] [lind
6f20: 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 ex $x 2] [llengt
6f30: 68 20 24 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e 30 h $x].} {127.0.0
6f40: 2e 31 20 38 38 32 39 20 33 7d 0a 0a 74 65 73 74 .1 8829 3}..test
6f50: 20 74 6c 73 49 4f 2d 38 2e 31 20 7b 74 65 73 74 tlsIO-8.1 {test
6f60: 69 6e 67 20 2d 61 73 79 6e 63 20 66 6c 61 67 20 ing -async flag
6f70: 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 7b 75 6e 65 on sockets} {une
6f80: 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f 63 xplainedHang soc
6f90: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 ket} {. # HOB
6fa0: 42 53 3a 20 73 74 69 6c 6c 20 66 61 69 6c 73 20 BS: still fails
6fb0: 70 6f 73 74 2d 72 65 77 72 69 74 65 0a 20 20 20 post-rewrite.
6fc0: 20 23 20 74 65 73 74 20 73 65 65 6d 73 20 74 6f # test seems to
6fd0: 20 68 61 6e 67 20 2d 2d 20 61 77 62 20 36 2f 32 hang -- awb 6/2
6fe0: 2f 32 30 30 30 0a 20 20 20 20 23 20 4e 4f 54 45 /2000. # NOTE
6ff0: 3a 20 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 : This test may
7000: 66 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c fail on some Sol
7010: 61 72 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 aris 2.4 systems
7020: 2e 20 49 66 20 69 74 20 64 6f 65 73 2c 0a 20 20 . If it does,.
7030: 20 20 23 20 63 68 65 63 6b 20 74 68 61 74 20 79 # check that y
7040: 6f 75 20 68 61 76 65 20 74 68 65 73 65 20 70 61 ou have these pa
7050: 74 63 68 65 73 20 69 6e 73 74 61 6c 6c 65 64 20 tches installed
7060: 28 75 73 69 6e 67 20 73 68 6f 77 72 65 76 20 2d (using showrev -
7070: 70 29 3a 0a 20 20 20 20 23 0a 20 20 20 20 23 20 p):. #. #
7080: 31 30 31 39 30 37 2d 30 35 2c 20 31 30 31 39 32 101907-05, 10192
7090: 35 2d 30 32 2c 20 31 30 31 39 34 35 2d 31 34 2c 5-02, 101945-14,
70a0: 20 31 30 31 39 35 39 2d 30 33 2c 20 31 30 31 39 101959-03, 1019
70b0: 36 39 2d 30 35 2c 20 31 30 31 39 37 33 2d 30 33 69-05, 101973-03
70c0: 2c 0a 20 20 20 20 23 20 31 30 31 39 37 37 2d 30 ,. # 101977-0
70d0: 33 2c 20 31 30 31 39 38 31 2d 30 32 2c 20 31 30 3, 101981-02, 10
70e0: 31 39 38 35 2d 30 31 2c 20 31 30 32 30 30 31 2d 1985-01, 102001-
70f0: 30 33 2c 20 31 30 32 30 30 33 2d 30 31 2c 20 31 03, 102003-01, 1
7100: 30 32 30 30 37 2d 30 31 2c 0a 20 20 20 20 23 20 02007-01,. #
7110: 31 30 32 30 31 31 2d 30 32 2c 20 31 30 32 30 32 102011-02, 10202
7120: 34 2d 30 31 2c 20 31 30 32 30 33 39 2d 30 31 2c 4-01, 102039-01,
7130: 20 31 30 32 30 34 34 2d 30 31 2c 20 31 30 32 30 102044-01, 1020
7140: 34 38 2d 30 31 2c 20 31 30 32 30 36 32 2d 30 33 48-01, 102062-03
7150: 2c 0a 20 20 20 20 23 20 31 30 32 30 36 36 2d 30 ,. # 102066-0
7160: 34 2c 20 31 30 32 30 37 30 2d 30 31 2c 20 31 30 4, 102070-01, 10
7170: 32 31 30 35 2d 30 31 2c 20 31 30 32 31 35 33 2d 2105-01, 102153-
7180: 30 33 2c 20 31 30 32 32 31 36 2d 30 31 2c 20 31 03, 102216-01, 1
7190: 30 32 32 33 32 2d 30 31 2c 0a 20 20 20 20 23 20 02232-01,. #
71a0: 31 30 31 38 37 38 2d 30 33 2c 20 31 30 31 38 37 101878-03, 10187
71b0: 39 2d 30 31 2c 20 31 30 31 38 38 30 2d 30 33 2c 9-01, 101880-03,
71c0: 20 31 30 31 39 33 33 2d 30 31 2c 20 31 30 31 39 101933-01, 1019
71d0: 35 30 2d 30 31 2c 20 31 30 32 30 33 30 2d 30 31 50-01, 102030-01
71e0: 2c 0a 20 20 20 20 23 20 31 30 32 30 35 37 2d 30 ,. # 102057-0
71f0: 38 2c 20 31 30 32 31 34 30 2d 30 31 2c 20 31 30 8, 102140-01, 10
7200: 31 39 32 30 2d 30 32 2c 20 31 30 31 39 32 31 2d 1920-02, 101921-
7210: 30 39 2c 20 31 30 31 39 32 32 2d 30 37 2c 20 31 09, 101922-07, 1
7220: 30 31 39 32 33 2d 30 33 0a 20 20 20 20 23 0a 20 01923-03. #.
7230: 20 20 20 23 20 49 66 20 61 66 74 65 72 20 69 6e # If after in
7240: 73 74 61 6c 6c 69 6e 67 20 74 68 65 73 65 20 70 stalling these p
7250: 61 74 63 68 65 73 20 79 6f 75 20 61 72 65 20 73 atches you are s
7260: 74 69 6c 6c 20 65 78 70 65 72 69 65 6e 63 69 6e till experiencin
7270: 67 20 61 0a 20 20 20 20 23 20 70 72 6f 62 6c 65 g a. # proble
7280: 6d 2c 20 70 6c 65 61 73 65 20 65 6d 61 69 6c 20 m, please email
7290: 6a 79 6c 40 65 6e 67 2e 73 75 6e 2e 63 6f 6d 2e jyl@eng.sun.com.
72a0: 20 57 65 20 68 61 76 65 20 6e 6f 74 20 6f 62 73 We have not obs
72b0: 65 72 76 65 64 20 74 68 69 73 0a 20 20 20 20 23 erved this. #
72c0: 20 66 61 69 6c 75 72 65 20 6f 6e 20 53 6f 6c 61 failure on Sola
72d0: 72 69 73 20 32 2e 35 2c 20 73 6f 20 61 6e 6f 74 ris 2.5, so anot
72e0: 68 65 72 20 6f 70 74 69 6f 6e 20 28 69 6e 73 74 her option (inst
72f0: 65 61 64 20 6f 66 20 69 6e 73 74 61 6c 6c 69 6e ead of installin
7300: 67 0a 20 20 20 20 23 20 74 68 65 73 65 20 70 61 g. # these pa
7310: 74 63 68 65 73 29 20 69 73 20 74 6f 20 75 70 67 tches) is to upg
7320: 72 61 64 65 20 74 6f 20 53 6f 6c 61 72 69 73 20 rade to Solaris
7330: 32 2e 35 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 2.5.. set s [
7340: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
7350: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
7360: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7370: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
7380: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
7390: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
73a0: 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 830]. proc ac
73b0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
73c0: 67 6c 6f 62 61 6c 20 78 0a 09 70 75 74 73 20 24 global x..puts $
73d0: 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a s bye..close $s.
73e0: 09 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 .set x done.
73f0: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
7400: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
7410: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
7420: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
7430: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
7440: 65 6e 74 4b 65 79 20 5c 0a 09 2d 61 73 79 6e 63 entKey \..-async
7450: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
7460: 20 38 38 33 30 5d 0a 20 20 20 20 76 77 61 69 74 8830]. vwait
7470: 20 78 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65 x. set z [ge
7480: 74 73 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 ts $s1]. clos
7490: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
74a0: 73 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 s1. set z.} b
74b0: 79 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 ye..test tlsIO-9
74c0: 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 .1 {testing spur
74d0: 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 75 6e ious events} {un
74e0: 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f explainedHang so
74f0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 48 4f cket} {. # HO
7500: 42 42 53 3a 20 73 74 69 6c 6c 20 66 61 69 6c 73 BBS: still fails
7510: 20 70 6f 73 74 2d 72 65 77 72 69 74 65 0a 20 20 post-rewrite.
7520: 20 20 23 20 6c 6f 63 6b 73 20 75 70 20 0a 20 20 # locks up .
7530: 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 set len 0.
7540: 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 set spurious 0.
7550: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
7560: 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c proc readlittl
7570: 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 e {s} {..global
7580: 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 spurious done le
7590: 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 n..set l [read $
75a0: 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e s 1]..if {[strin
75b0: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 g length $l] ==
75c0: 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 0} {.. if {![
75d0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 eof $s]} {...inc
75e0: 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 r spurious..
75f0: 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 } else {...close
7600: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 $s...set done 1
7610: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
7620: 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 {.. incr len
7630: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
7640: 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 l]..}. }.
7650: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
7660: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
7670: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
7680: 6e 6f 6e 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f none -blocking o
7690: 66 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 ff..fileevent $s
76a0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
76b0: 72 65 61 64 6c 69 74 74 6c 65 20 24 73 5d 0a 20 readlittle $s].
76c0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
76d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
76e0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
76f0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7700: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
7710: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 09 2d erverKey \. .-
7720: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
7730: 33 31 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 31]. set c [t
7740: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
7750: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
7760: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
7770: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
7780: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 5b ientKey \. .[
7790: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 info hostname] 8
77a0: 38 33 31 5d 0a 20 20 20 20 70 75 74 73 20 2d 6e 831]. puts -n
77b0: 6f 6e 65 77 6c 69 6e 65 20 24 63 20 30 31 32 33 onewline $c 0123
77c0: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
77d0: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 0123456789012345
77e0: 36 37 38 39 30 31 32 33 34 35 36 37 38 39 0a 20 67890123456789.
77f0: 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 close $c.
7800: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
7810: 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 10000 "set done
7820: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
7830: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
7840: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
7850: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
7860: 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 69 . list $spuri
7870: 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 ous $len.} {0 50
7880: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e }..test tlsIO-9.
7890: 32 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 2 {testing async
78a0: 20 77 72 69 74 65 2c 20 66 69 6c 65 65 76 65 6e write, fileeven
78b0: 74 73 2c 20 66 6c 75 73 68 20 6f 6e 20 63 6c 6f ts, flush on clo
78c0: 73 65 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 se} {socket} {.
78d0: 20 20 20 23 20 48 4f 42 42 53 3a 20 54 68 69 73 # HOBBS: This
78e0: 20 68 61 6e 67 73 20 77 68 65 6e 20 49 20 74 75 hangs when I tu
78f0: 72 6e 20 62 6c 6f 63 6b 69 6e 67 20 6f 6e 2e 0a rn blocking on..
7900: 20 20 20 20 23 0a 20 20 20 20 73 65 74 20 66 69 #. set fi
7910: 72 73 74 62 6c 6f 63 6b 20 22 22 0a 20 20 20 20 rstblock "".
7920: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
7930: 69 20 3c 20 35 7d 20 7b 69 6e 63 72 20 69 7d 20 i < 5} {incr i}
7940: 7b 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 {set firstblock
7950: 22 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 66 69 "a$firstblock$fi
7960: 72 73 74 62 6c 6f 63 6b 22 7d 0a 20 20 20 20 73 rstblock"}. s
7970: 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 et secondblock "
7980: 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 ". for {set i
7990: 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d 20 7b 69 0} {$i < 16} {i
79a0: 6e 63 72 20 69 7d 20 7b 0a 09 73 65 74 20 73 65 ncr i} {..set se
79b0: 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 65 63 condblock "b$sec
79c0: 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 ondblock$secondb
79d0: 6c 6f 63 6b 22 0a 20 20 20 20 7d 0a 20 20 20 20 lock". }.
79e0: 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b set l [tls::sock
79f0: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
7a00: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
7a10: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7a20: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
7a30: 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 \. .-server a
7a40: 63 63 65 70 74 20 38 38 33 32 5d 0a 20 20 20 20 ccept 8832].
7a50: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
7a60: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
7a70: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
7a80: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
7a90: 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 -buffersize 163
7aa0: 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 84 \...-bufferin
7ab0: 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e g line..fileeven
7ac0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
7ad0: 65 61 64 61 62 6c 65 20 24 73 22 0a 20 20 20 20 eadable $s".
7ae0: 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 }. proc reada
7af0: 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c ble {s} {..set l
7b00: 20 5b 67 65 74 73 20 24 73 5d 0a 09 66 69 6c 65 [gets $s]..file
7b10: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
7b20: 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 30 e {}..after 1000
7b30: 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 20 respond $s.
7b40: 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 6f }. proc respo
7b50: 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c nd {s} {..global
7b60: 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 70 75 74 firstblock..put
7b70: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 s -nonewline $s
7b80: 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 74 $firstblock..aft
7b90: 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 er 1000 writedat
7ba0: 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 a $s. }. p
7bb0: 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 roc writedata {s
7bc0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 6f } {..global seco
7bd0: 6e 64 62 6c 6f 63 6b 0a 09 70 75 74 73 20 2d 6e ndblock..puts -n
7be0: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 onewline $s $sec
7bf0: 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 ondblock..close
7c00: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 $s. }. set
7c10: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
7c20: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
7c30: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
7c40: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7c50: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
7c60: 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 .[info hostna
7c70: 6d 65 5d 20 38 38 33 32 5d 0a 20 20 20 20 66 63 me] 8832]. fc
7c80: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f onfigure $s -blo
7c90: 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c cking 0 -trans l
7ca0: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
7cb0: 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 e. set count
7cc0: 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 65 0. puts $s he
7cd0: 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 61 llo. proc rea
7ce0: 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 dit {s} {..globa
7cf0: 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 l count done..se
7d00: 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 t l [read $s]..i
7d10: 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e ncr count [strin
7d20: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 g length $l]..if
7d30: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
7d40: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 close $s..
7d50: 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 set done 1..}.
7d60: 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 }. fileeve
7d70: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
7d80: 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 readit $s". s
7d90: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 et done 0. se
7da0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
7db0: 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 0000 "set done t
7dc0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
7dd0: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 wait done. af
7de0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
7df0: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 6c 0a 20 r. close $l.
7e00: 20 20 20 6c 69 73 74 20 24 63 6f 75 6e 74 20 24 list $count $
7e10: 64 6f 6e 65 0a 7d 20 7b 36 35 35 36 36 20 31 7d done.} {65566 1}
7e20: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 33 ..test tlsIO-9.3
7e30: 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 {testing EOF st
7e40: 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 ickyness} {unexp
7e50: 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f 63 6b 65 lainedHang socke
7e60: 74 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 t} {. # HOBBS
7e70: 3a 20 73 74 69 6c 6c 20 66 61 69 6c 73 20 70 6f : still fails po
7e80: 73 74 2d 72 65 77 72 69 74 65 0a 20 20 20 20 23 st-rewrite. #
7e90: 20 68 61 6e 67 73 0a 20 20 20 20 70 72 6f 63 20 hangs. proc
7ea0: 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d count_to_eof {s}
7eb0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
7ec0: 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 done timer..set
7ed0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 l [gets $s]..if
7ee0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
7ef0: 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 incr count..
7f00: 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 if {$count >
7f10: 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 9} {...close $s.
7f20: 09 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a ..set done true.
7f30: 09 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 ..set count {eof
7f40: 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 is sticky}...af
7f50: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
7f60: 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 r.. }..}.
7f70: 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 72 }. proc timer
7f80: 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 proc {} {..globa
7f90: 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 l done count c..
7fa0: 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 set done true..s
7fb0: 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 et count {timer
7fc0: 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 went off, eof is
7fd0: 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c not sticky}..cl
7fe0: 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 0a 20 20 ose $c. }..
7ff0: 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 set count 0.
8000: 20 20 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 set done false
8010: 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 5f . proc write_
8020: 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b then_close {s} {
8030: 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 ..puts $s bye..c
8040: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
8050: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
8060: 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 a p} {..fconfig
8070: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
8080: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
8090: 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e ion lf..fileeven
80a0: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 77 t $s writable "w
80b0: 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 rite_then_close
80c0: 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s". }. se
80d0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
80e0: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \..-certfile $s
80f0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
8100: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8110: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8120: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
8130: 65 70 74 20 38 38 33 33 5d 0a 20 20 20 20 73 65 ept 8833]. se
8140: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
8150: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
8160: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
8170: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8180: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
8190: 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e .[info hostn
81a0: 61 6d 65 5d 20 38 38 33 33 5d 0a 20 20 20 20 66 ame] 8833]. f
81b0: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
81c0: 6f 63 6b 69 6e 67 20 6f 66 66 20 2d 62 75 66 66 ocking off -buff
81d0: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
81e0: 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 slation lf. f
81f0: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
8200: 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 able "count_to_e
8210: 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 of $c". set t
8220: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
8230: 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 timerproc].
8240: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 vwait done. c
8250: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
8260: 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 count.} {eof is
8270: 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 sticky}..removeF
8280: 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 74 ile script..test
8290: 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 tlsIO-10.1 {tes
82a0: 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 63 65 ting socket acce
82b0: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
82c0: 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 r handling} {soc
82d0: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 ket} {. set g
82e0: 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 72 oterror 0. pr
82f0: 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 oc bgerror args
8300: 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 {global goterror
8310: 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 31 ; set goterror 1
8320: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
8330: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
8340: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
8350: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8360: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
8370: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
8380: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 39 38 rver accept 8898
8390: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
83a0: 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 t {s a p} {close
83b0: 20 24 73 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 $s; error}.
83c0: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
83d0: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
83e0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
83f0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8400: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
8410: 5c 0a 09 31 32 37 2e 30 2e 30 2e 31 20 38 38 39 \..127.0.0.1 889
8420: 38 5d 0a 20 20 20 20 76 77 61 69 74 20 67 6f 74 8]. vwait got
8430: 65 72 72 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 error. close
8440: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a $s. close $c.
8450: 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 set goterror
8460: 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f .} 1..test tlsIO
8470: 2d 31 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 -11.1 {tcp conne
8480: 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 ction} {socket d
8490: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
84a0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
84b0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
84c0: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
84d0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
84e0: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
84f0: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
8500: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8510: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
8520: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
8530: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
8540: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
8550: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
8560: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
8570: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
8580: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
8590: 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 31 5f ..set socket9_1_
85a0: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
85b0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
85c0: 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 accept \...-cer
85d0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
85e0: 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 t \...-cafile $c
85f0: 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 aCert \...-keyfi
8600: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8610: 09 09 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 ..8834]..proc ac
8620: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
8630: 20 20 20 20 70 75 74 73 20 24 73 20 64 6f 6e 65 puts $s done
8640: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
8650: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 63 6c 6f hake $s.. clo
8660: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
8670: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8680: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8690: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
86a0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
86b0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
86c0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
86d0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
86e0: 33 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 34]. set r [g
86f0: 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ets $s]. clos
8700: 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d e $s. sendCom
8710: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
8720: 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 ket9_1_test_serv
8730: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
8740: 64 6f 6e 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f done..test tlsIO
8750: 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 -11.2 {client sp
8760: 65 63 69 66 69 65 73 20 69 74 73 20 70 6f 72 74 ecifies its port
8770: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
8780: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
8790: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d r} {. sendCom
87a0: 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 mand "set caCert
87b0: 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 $caCert". se
87c0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
87d0: 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 erverCert $serve
87e0: 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 rCert". sendC
87f0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
8800: 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 ntCert $clientCe
8810: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8820: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b and "set serverK
8830: 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 ey $serverKey".
8840: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8850: 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 set clientKey $c
8860: 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 69 66 lientKey". if
8870: 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 {[info exists p
8880: 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 6f ort]} {..incr po
8890: 72 74 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a rt. } else {.
88a0: 09 73 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 .set port [expr
88b0: 24 74 6c 73 53 65 72 76 65 72 50 6f 72 74 20 2b $tlsServerPort +
88c0: 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 [pid]%1024].
88d0: 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }. sendComma
88e0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
88f0: 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 9_2_test_server
8900: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
8910: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 rver accept \...
8920: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
8930: 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c rCert \...-cafil
8940: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b e $caCert \...-k
8950: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
8960: 79 20 5c 0a 09 20 20 20 20 38 38 33 35 5d 0a 09 y \.. 8835]..
8970: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
8980: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
8990: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
89a0: 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 puts $s $p..
89b0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
89c0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
89d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
89e0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
89f0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8a00: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8a10: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8a20: 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 -myport $port
8a30: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
8a40: 20 38 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 8835]. set r
8a50: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
8a60: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 lose $s. send
8a70: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
8a80: 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 socket9_2_test_s
8a90: 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 erver}. if {$
8aa0: 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 r == $port} {..s
8ab0: 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 et result ok.
8ac0: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 } else {..set r
8ad0: 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 esult broken.
8ae0: 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c }. set resul
8af0: 74 0a 7d 20 6f 6b 0a 74 65 73 74 20 74 6c 73 49 t.} ok.test tlsI
8b00: 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 O-11.3 {trying t
8b10: 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 o connect, no se
8b20: 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f rver} {socket do
8b30: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8b40: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 erver} {. set
8b50: 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 status ok. i
8b60: 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 f {![catch {set
8b70: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
8b80: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8b90: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
8ba0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8bb0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
8bc0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
8bd0: 72 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d 20 rverIp 8836]}]}
8be0: 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b {..if {![catch {
8bf0: 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 gets $s}]} {..
8c00: 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f set status bro
8c10: 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 ken..}..close $s
8c20: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
8c30: 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 tatus.} ok..test
8c40: 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d tlsIO-11.4 {rem
8c50: 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 ote echo, one li
8c60: 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ne} {socket doTe
8c70: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
8c80: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
8c90: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 ommand "set caCe
8ca0: 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 rt $caCert".
8cb0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8cc0: 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 serverCert $ser
8cd0: 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e verCert". sen
8ce0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
8cf0: 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 ientCert $client
8d00: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
8d10: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
8d20: 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 rKey $serverKey"
8d30: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8d40: 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 "set clientKey
8d50: 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 $clientKey".
8d60: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 20 20 sendCommand {.
8d70: 20 20 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 .global server
8d80: 43 65 72 74 0a 09 67 6c 6f 62 61 6c 20 63 61 43 Cert..global caC
8d90: 65 72 74 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 ert..global serv
8da0: 65 72 4b 65 79 0a 09 73 65 74 20 73 6f 63 6b 65 erKey..set socke
8db0: 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 t10_6_test_serve
8dc0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
8dd0: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
8de0: 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 rverCert \...-ca
8df0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
8e00: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
8e10: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
8e20: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 accept 8836]..p
8e30: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
8e40: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
8e50: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
8e60: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
8e70: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
8e80: 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 o $s].. fconf
8e90: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
8ea0: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
8eb0: 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 ation crlf..}..p
8ec0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
8ed0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
8ee0: 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f $s].. if {[eo
8ef0: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
8f00: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 $s.. } else
8f10: 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 {...puts $s $l..
8f20: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
8f30: 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 set f [tls::s
8f40: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8f50: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
8f60: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8f70: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
8f80: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
8f90: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
8fa0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
8fb0: 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 re $f -translati
8fc0: 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 on crlf -bufferi
8fd0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 ng line. puts
8fe0: 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 $f hello. se
8ff0: 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t r [gets $f].
9000: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
9010: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
9020: 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 e $socket10_6_te
9030: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
9040: 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 et r.} hello..te
9050: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 st tlsIO-11.5 {r
9060: 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c emote echo, 50 l
9070: 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ines} {socket do
9080: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
9090: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
90a0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 dCommand "set ca
90b0: 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 Cert $caCert".
90c0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
90d0: 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 et serverCert $s
90e0: 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 erverCert". s
90f0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
9100: 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 clientCert $clie
9110: 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 ntCert". send
9120: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
9130: 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 verKey $serverKe
9140: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
9150: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 nd "set clientKe
9160: 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 y $clientKey".
9170: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
9180: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f .set socket10_7_
9190: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
91a0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
91b0: 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 accept \...-cer
91c0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
91d0: 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 t \...-cafile $c
91e0: 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 aCert \...-keyfi
91f0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
9200: 09 09 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 ..8836]..proc ac
9210: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
9220: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
9230: 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 ke $s.. filee
9240: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
9250: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
9260: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9270: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
9280: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
9290: 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 crlf..}..proc ec
92a0: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 ho {s} {.. se
92b0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 t l [gets $s]..
92c0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
92d0: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 {...close $s..
92e0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 } else {...pu
92f0: 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a ts $s $l.. }.
9300: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
9310: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
9320: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9330: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9340: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9350: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9360: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9370: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
9380: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 fconfigure $f
9390: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
93a0: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
93b0: 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 e. for {set c
93c0: 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 nt 0} {$cnt < 50
93d0: 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 } {incr cnt} {..
93e0: 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 puts $f "hello,
93f0: 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 69 $cnt"..if {[stri
9400: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 73 ng compare [gets
9410: 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 6e $f] "hello, $cn
9420: 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 t"] != 0} {..
9430: 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a break..}. }.
9440: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
9450: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
9460: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f ose $socket10_7_
9470: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
9480: 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 set cnt.} 50..#
9490: 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 Macintosh socke
94a0: 74 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 ts can have more
94b0: 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 than one server
94c0: 20 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 per port.if {$t
94d0: 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 cl_platform(plat
94e0: 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e 74 form) == "macint
94f0: 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 osh"} {. set
9500: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b conflictResult {
9510: 30 20 38 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0 8836}.} else {
9520: 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 . set conflic
9530: 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c tResult {1 {coul
9540: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
9550: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
9560: 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 y in use}}.}..te
9570: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 st tlsIO-11.6 {s
9580: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
9590: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
95a0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
95b0: 20 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 {. set s1 [t
95c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
95d0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
95e0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
95f0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9600: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
9610: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
9620: 74 20 38 38 33 36 5d 0a 20 20 20 20 69 66 20 7b t 8836]. if {
9630: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b [catch {set s2 [
9640: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9650: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
9660: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
9670: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9680: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
9690: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
96a0: 70 74 20 38 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 pt 8836]} msg]}
96b0: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c {..set result [l
96c0: 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 ist 1 $msg].
96d0: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 } else {..set re
96e0: 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 sult [list 0 [li
96f0: 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 ndex [fconfigure
9700: 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 $s2 -sockname]
9710: 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 2]]..close $s2.
9720: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
9730: 73 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c s1. set resul
9740: 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 t.} $conflictRes
9750: 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ult..test tlsIO-
9760: 31 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 11.7 {server wit
9770: 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 h several client
9780: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
9790: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
97a0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
97b0: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
97c0: 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 ket10_9_test_ser
97d0: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
97e0: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 5b \...-certfile [
97f0: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9800: 63 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 6d certs server.pem
9810: 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 ] \...-cafile [f
9820: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9830: 65 72 74 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d erts caFile.pem]
9840: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 \...-keyfile [f
9850: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9860: 65 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c erts skey.pem] \
9870: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
9880: 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 8836]..proc ac
9890: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
98a0: 20 20 20 20 23 20 68 61 6e 64 73 68 61 6b 65 20 # handshake
98b0: 6c 6f 63 6b 73 20 75 70 20 74 68 65 20 74 68 72 locks up the thr
98c0: 65 65 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 63 ee synchronous c
98d0: 6c 69 65 6e 74 73 0a 09 20 20 20 20 23 20 74 6c lients.. # tl
98e0: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
98f0: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9900: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
9910: 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e ne.. fileeven
9920: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
9930: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a ist echo $s]..}.
9940: 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b .proc echo {s} {
9950: 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 .. set l [get
9960: 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b s $s].. if {[
9970: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f eof $s]} {...clo
9980: 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 se $s.. } els
9990: 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c e {...puts $s $l
99a0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
99b0: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
99c0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
99d0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
99e0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
99f0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9a00: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9a10: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9a20: 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 8836]. fconf
9a30: 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 igure $s1 -buffe
9a40: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
9a50: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
9a60: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
9a70: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
9a80: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9a90: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
9aa0: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
9ab0: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
9ac0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
9ad0: 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s2 -buffering li
9ae0: 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 ne. set s3 [t
9af0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9b00: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9b10: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9b20: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9b30: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9b40: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9b50: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 8836]. fco
9b60: 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 nfigure $s3 -buf
9b70: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
9b80: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
9b90: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
9ba0: 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 } {..puts $s1 he
9bb0: 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 llo,s1..gets $s1
9bc0: 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f ..puts $s2 hello
9bd0: 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 ,s2..gets $s2..p
9be0: 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 uts $s3 hello,s3
9bf0: 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d ..gets $s3. }
9c00: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
9c10: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
9c20: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 close $s3. s
9c30: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
9c40: 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 e $socket10_9_te
9c50: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
9c60: 65 74 20 69 0a 7d 20 31 30 30 20 20 20 20 0a 0a et i.} 100 ..
9c70: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 38 20 test tlsIO-11.8
9c80: 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 73 65 76 {client with sev
9c90: 65 72 61 6c 20 73 65 72 76 65 72 73 7d 20 7b 75 eral servers} {u
9ca0: 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 nexplainedHang s
9cb0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9cc0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9cd0: 0a 20 20 20 20 23 20 74 68 69 73 20 6f 6e 65 20 . # this one
9ce0: 73 65 65 6d 73 20 74 6f 20 68 61 6e 67 20 2d 2d seems to hang --
9cf0: 20 61 77 62 20 36 2f 32 2f 32 30 30 30 0a 20 20 awb 6/2/2000.
9d00: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
9d10: 09 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f .set s1 [tls::so
9d20: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
9d30: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
9d40: 77 64 5d 20 63 65 72 74 73 20 73 65 72 76 65 72 wd] certs server
9d50: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 6c .pem] \...-cafil
9d60: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
9d70: 64 5d 20 63 65 72 74 73 20 63 61 46 69 6c 65 2e d] certs caFile.
9d80: 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 6c pem] \...-keyfil
9d90: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
9da0: 64 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 65 d] certs skey.pe
9db0: 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 22 m] \...-server "
9dc0: 61 63 63 65 70 74 20 34 30 30 33 22 20 34 30 30 accept 4003" 400
9dd0: 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3]..set s2 [tls:
9de0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
9df0: 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e tfile [file join
9e00: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 65 72 [pwd] certs ser
9e10: 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 ver.pem] \...-ca
9e20: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
9e30: 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 46 69 [pwd] certs caFi
9e40: 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 le.pem] \...-key
9e50: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
9e60: 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b 65 79 [pwd] certs skey
9e70: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 .pem] \...-serve
9e80: 72 20 22 61 63 63 65 70 74 20 34 30 30 34 22 20 r "accept 4004"
9e90: 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 4004]..set s3 [t
9ea0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
9eb0: 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a certfile [file j
9ec0: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9ed0: 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 server.pem] \...
9ee0: 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f -cafile [file jo
9ef0: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 in [pwd] certs c
9f00: 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d aFile.pem] \...-
9f10: 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f keyfile [file jo
9f20: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 in [pwd] certs s
9f30: 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 key.pem] \...-se
9f40: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
9f50: 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 20 61 5" 4005]..proc a
9f60: 63 63 65 70 74 20 7b 6d 70 20 73 20 61 20 70 7d ccept {mp s a p}
9f70: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
9f80: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 70 dshake $s.. p
9f90: 75 74 73 20 24 73 20 24 6d 70 0a 09 20 20 20 20 uts $s $mp..
9fa0: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
9fb0: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
9fc0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9fd0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
9fe0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
9ff0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a000: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
a010: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
a020: 50 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 20 P 4003]. set
a030: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
a040: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
a050: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
a060: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a070: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
a080: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
a090: 65 72 76 65 72 49 50 20 34 30 30 34 5d 0a 20 20 erverIP 4004].
a0a0: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
a0b0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
a0c0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
a0d0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
a0e0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
a0f0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
a100: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 emoteServerIP 40
a110: 30 35 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 05]. set l ""
a120: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
a130: 67 65 74 73 20 24 73 31 5d 20 5b 67 65 74 73 20 gets $s1] [gets
a140: 24 73 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b $s1] [eof $s1] [
a150: 67 65 74 73 20 24 73 32 5d 20 5b 67 65 74 73 20 gets $s2] [gets
a160: 24 73 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c $s2] [eof $s2] \
a170: 0a 09 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 65 ..[gets $s3] [ge
a180: 74 73 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 ts $s3] [eof $s3
a190: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a ]. close $s1.
a1a0: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
a1b0: 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 close $s3.
a1c0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 sendCommand {..c
a1d0: 6c 6f 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 lose $s1..close
a1e0: 24 73 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 $s2..close $s3.
a1f0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d }. set l.}
a200: 20 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 34 {4003 {} 1 4004
a210: 20 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 7d {} 1 4005 {} 1}
a220: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
a230: 39 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 9 {accept callba
a240: 63 6b 20 65 72 72 6f 72 7d 20 7b 6b 6e 6f 77 6e ck error} {known
a250: 42 75 67 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 Bug socket doTes
a260: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a270: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 er} {. set s
a280: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a290: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
a2a0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
a2b0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a2c0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
a2d0: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
a2e0: 65 70 74 20 38 38 33 36 5d 0a 20 20 20 20 70 72 ept 8836]. pr
a2f0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
a300: 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a } {expr 10 / 0}.
a310: 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 proc bgerror
a320: 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 args {..global
a330: 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 x..set x $args.
a340: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d }. sendCom
a350: 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 mand "set caCert
a360: 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 $caCert". se
a370: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
a380: 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 erverCert $serve
a390: 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 rCert". sendC
a3a0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
a3b0: 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 ntCert $clientCe
a3c0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
a3d0: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b and "set serverK
a3e0: 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 ey $serverKey".
a3f0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a400: 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 set clientKey $c
a410: 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 69 66 lientKey". if
a420: 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f {[catch {sendCo
a430: 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 mmand {.. set
a440: 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 peername [fconf
a450: 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 igure $callerSoc
a460: 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 ket -peername]..
a470: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
a480: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
a490: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
a4a0: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 \...-cafile $ca
a4b0: 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c Cert \...-keyfil
a4c0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
a4d0: 20 20 20 20 09 5b 6c 69 6e 64 65 78 20 24 70 65 .[lindex $pe
a4e0: 65 72 6e 61 6d 65 20 30 5d 20 38 38 33 36 5d 0a ername 0] 8836].
a4f0: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
a500: 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 . }} msg]} {..
a510: 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 close $s..error
a520: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
a530: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
a540: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
a550: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
a560: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
a570: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
a580: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 close $s. re
a590: 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a name bgerror {}.
a5a0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 set x.} {{di
a5b0: 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a vide by zero}}..
a5c0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 test tlsIO-11.10
a5d0: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
a5e0: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
a5f0: 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 46 s} {unexplainedF
a600: 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 20 64 6f ailure socket do
a610: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
a620: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
a630: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 dCommand "set ca
a640: 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 Cert $caCert".
a650: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
a660: 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 et serverCert $s
a670: 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 erverCert". s
a680: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
a690: 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 clientCert $clie
a6a0: 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 ntCert". send
a6b0: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
a6c0: 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 verKey $serverKe
a6d0: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
a6e0: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 nd "set clientKe
a6f0: 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 y $clientKey".
a700: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
a710: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 32 .set socket10_12
a720: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
a730: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 s::socket \...-c
a740: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
a750: 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 ert \...-cafile
a760: 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 $caCert \...-key
a770: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
a780: 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 \...-server acce
a790: 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 pt 8836]..proc a
a7a0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 ccept {s a p} {c
a7b0: 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 lose $s}. }.
a7c0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
a7d0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
a7e0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
a7f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
a800: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
a810: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
a820: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
a830: 33 36 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 36]. set p [f
a840: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 configure $s -pe
a850: 65 72 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 ername]. set
a860: 6e 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 n [fconfigure $s
a870: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 -sockname].
a880: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
a890: 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 pend l [lindex $
a8a0: 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 p 2] [llength $p
a8b0: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 ] [llength $p].
a8c0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
a8d0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
a8e0: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f se $socket10_12_
a8f0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
a900: 20 73 65 74 20 6c 0a 7d 20 7b 38 38 33 36 20 33 set l.} {8836 3
a910: 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 3}..test tlsIO-
a920: 31 31 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 73 11.11 {testing s
a930: 70 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 purious events}
a940: 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 {unexplainedHang
a950: 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 socket doTestsW
a960: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
a970: 20 7b 0a 20 20 20 20 23 20 68 61 6e 67 73 0a 20 {. # hangs.
a980: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a990: 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 set caCert $caCe
a9a0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
a9b0: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 and "set serverC
a9c0: 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 ert $serverCert"
a9d0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a9e0: 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 "set clientCert
a9f0: 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 $clientCert".
aa00: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
aa10: 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 et serverKey $se
aa20: 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e rverKey". sen
aa30: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
aa40: 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b ientKey $clientK
aa50: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
aa60: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
aa70: 74 31 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 t10_13_test_serv
aa80: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
aa90: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
aaa0: 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 erverCert \...-c
aab0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
aac0: 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 ..-keyfile $serv
aad0: 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 erKey \...-serve
aae0: 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 r accept 8836]..
aaf0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
ab00: 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a p} {.. tls::
ab10: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
ab20: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
ab30: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 -translation "au
ab40: 74 6f 20 6c 66 22 0a 09 20 20 20 20 61 66 74 65 to lf".. afte
ab50: 72 20 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 r 100 writesome
ab60: 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 $s..}..proc writ
ab70: 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 esome {s} {..
ab80: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
ab90: 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 $i < 100} {incr
aba0: 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 i} {...puts $s "
abb0: 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d line $i from rem
abc0: 6f 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 ote server"..
abd0: 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 }.. close $s
abe0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
abf0: 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 t len 0. set
ac00: 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 spurious 0. s
ac10: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 et done 0. pr
ac20: 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 oc readlittle {s
ac30: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 } {..global spur
ac40: 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 ious done len..s
ac50: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d et l [read $s 1]
ac60: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 ..if {[string le
ac70: 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b ngth $l] == 0} {
ac80: 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 .. if {![eof
ac90: 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 $s]} {...incr sp
aca0: 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c urious.. } el
acb0: 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a se {...close $s.
acc0: 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 ..set done 1..
acd0: 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 }..} else {..
ace0: 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 incr len [str
acf0: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 ing length $l]..
ad00: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
ad10: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c c [tls::socket \
ad20: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
ad30: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
ad40: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
ad50: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
ad60: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
ad70: 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 rverIP 8836].
ad80: 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 fileevent $c re
ad90: 61 64 61 62 6c 65 20 22 72 65 61 64 6c 69 74 74 adable "readlitt
ada0: 6c 65 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 le $c". set t
adb0: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
adc0: 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 0 "set done time
add0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
ade0: 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 t done. after
adf0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
ae00: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
ae10: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
ae20: 31 33 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 13_test_server}.
ae30: 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f list $spurio
ae40: 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 us $len.} {0 269
ae50: 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 0}..test tlsIO-1
ae60: 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 1.12 {testing EO
ae70: 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 6b F stickyness} {k
ae80: 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 20 64 nownBug socket d
ae90: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
aea0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
aeb0: 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 t counter 0.
aec0: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
aed0: 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 7d roc count_up {s}
aee0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
aef0: 65 72 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 64 er done after_id
af00: 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 ..set l [gets $s
af10: 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d ]..if {[eof $s]}
af20: 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 {.. incr cou
af30: 6e 74 65 72 0a 09 20 20 20 20 69 66 20 7b 24 63 nter.. if {$c
af40: 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 09 ounter > 9} {...
af50: 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 73 set done {EOF is
af60: 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 sticky}...after
af70: 20 63 61 6e 63 65 6c 20 24 61 66 74 65 72 5f 69 cancel $after_i
af80: 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 d...close $s..
af90: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
afa0: 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 20 proc timed_out
afb0: 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 64 {} {..global c d
afc0: 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b 74 one..set done {t
afd0: 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 73 imed_out, EOF is
afe0: 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c not sticky}..cl
aff0: 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 ose $c. }.
b000: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
b010: 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 t caCert $caCert
b020: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
b030: 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 d "set serverCer
b040: 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 t $serverCert".
b050: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
b060: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 set clientCert $
b070: 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 clientCert".
b080: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
b090: 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 serverKey $serv
b0a0: 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 erKey". sendC
b0b0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
b0c0: 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 ntKey $clientKey
b0d0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
b0e0: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
b0f0: 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 0_14_test_server
b100: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
b110: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
b120: 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 verCert \...-caf
b130: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 ile $caCert \...
b140: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
b150: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
b160: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 accept 8836]..pr
b170: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
b180: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
b190: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
b1a0: 61 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 after 100 close
b1b0: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
b1c0: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
b1d0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
b1e0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
b1f0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
b200: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
b210: 4b 65 79 20 5c 0a 20 20 20 20 09 24 72 65 6d 6f Key \. .$remo
b220: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
b230: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b240: 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e c readable "coun
b250: 74 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 74 t_up $c". set
b260: 20 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 72 after_id [after
b270: 20 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 1000 timed_out]
b280: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
b290: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b2a0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
b2b0: 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _14_test_server}
b2c0: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 . set done.}
b2d0: 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a {EOF is sticky}.
b2e0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
b2f0: 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 3 {testing async
b300: 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 6c write, async fl
b310: 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 ush, async close
b320: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
b330: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b340: 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 rver} {. proc
b350: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
b360: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
b370: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
b380: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
b390: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
b3a0: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
b3b0: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
b3c0: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
b3d0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e .}. }. sen
b3e0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 dCommand "set ca
b3f0: 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 Cert $caCert".
b400: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
b410: 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 et serverCert $s
b420: 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 erverCert". s
b430: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
b440: 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 clientCert $clie
b450: 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 ntCert". send
b460: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
b470: 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 verKey $serverKe
b480: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
b490: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 nd "set clientKe
b4a0: 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 y $clientKey".
b4b0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
b4c0: 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 .set firstblock
b4d0: 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 ""..for {set i 0
b4e0: 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 } {$i < 5} {incr
b4f0: 20 69 7d 20 7b 0a 09 09 73 65 74 20 66 69 72 73 i} {...set firs
b500: 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 62 tblock "a$firstb
b510: 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 lock$firstblock"
b520: 0a 09 7d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 ..}..set secondb
b530: 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 lock ""..for {se
b540: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d t i 0} {$i < 16}
b550: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 {incr i} {..
b560: 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b set secondblock
b570: 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 "b$secondblock$
b580: 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 09 7d 0a secondblock"..}.
b590: 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 .set l [tls::soc
b5a0: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
b5b0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
b5c0: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
b5d0: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
b5e0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
b5f0: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 34 erver accept 884
b600: 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 5]..proc accept
b610: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
b620: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
b630: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
b640: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
b650: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 -translation lf
b660: 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 -buffersize 1638
b670: 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 4 \...-buffering
b680: 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 line.. filee
b690: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
b6a0: 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 09 "readable $s"..
b6b0: 7d 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c 65 }..proc readable
b6c0: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 {s} {.. set
b6d0: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 l [gets $s]..
b6e0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
b6f0: 61 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 adable {}.. a
b700: 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e fter 1000 respon
b710: 64 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 d $s..}..proc re
b720: 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 spond {s} {..
b730: 20 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f global firstblo
b740: 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f ck.. puts -no
b750: 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 newline $s $firs
b760: 74 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 tblock.. afte
b770: 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 r 1000 writedata
b780: 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 $s..}..proc wri
b790: 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 tedata {s} {..
b7a0: 20 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 global secondb
b7b0: 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d lock.. puts -
b7c0: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 nonewline $s $se
b7d0: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 condblock.. c
b7e0: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
b7f0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
b800: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
b810: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
b820: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b830: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
b840: 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 lientKey \. .
b850: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
b860: 38 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8845]. fconfi
b870: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
b880: 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 g 0 -trans lf -b
b890: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
b8a0: 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 set count 0.
b8b0: 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a puts $s hello.
b8c0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
b8d0: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 readable "readi
b8e0: 74 20 24 73 22 0a 20 20 20 20 73 65 74 20 74 69 t $s". set ti
b8f0: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
b900: 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 "set done timed
b910: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
b920: 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 done. after
b930: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
b940: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
b950: 6c 6f 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 lose $l}. set
b960: 20 63 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a count.} 65566..
b970: 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 31 20 test tlsIO-12.1
b980: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
b990: 61 6e 63 65 20 6f 66 20 73 65 72 76 65 72 20 73 ance of server s
b9a0: 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b ockets} \..{sock
b9b0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
b9c0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
b9d0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
b9e0: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
b9f0: 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 ile script2..
ba00: 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 # Script1 is ju
ba10: 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 st a 10 second d
ba20: 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 elay. If the se
ba30: 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 rver socket.
ba40: 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 # is inherited,
ba50: 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 it will be held
ba60: 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f open for 10 seco
ba70: 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b nds.. set f [
ba80: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
ba90: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
baa0: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
bab0: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
bac0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
bad0: 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 f.. # Script2
bae0: 20 63 72 65 61 74 65 73 20 74 68 65 20 73 65 72 creates the ser
baf0: 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c 61 75 6e ver socket, laun
bb00: 63 68 65 73 20 73 63 72 69 70 74 31 2c 0a 20 20 ches script1,.
bb10: 20 20 23 20 77 61 69 74 73 20 61 20 73 65 63 6f # waits a seco
bb20: 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 2e 20 20 nd, and exits.
bb30: 54 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 The server socke
bb40: 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 20 23 t will now. #
bb50: 20 62 65 20 63 6c 6f 73 65 64 20 75 6e 6c 65 73 be closed unles
bb60: 73 20 73 63 72 69 70 74 31 20 69 6e 68 65 72 69 s script1 inheri
bb70: 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 73 65 74 ted it... set
bb80: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 f [open script2
bb90: 20 77 5d 0a 20 20 20 20 23 20 70 75 74 73 20 24 w]. # puts $
bba0: 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 74 f [list set tclt
bbb0: 65 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a est $::tcltest::
bbc0: 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 tcltest]. put
bbd0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 s $f [list set t
bbe0: 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f clsh [info nameo
bbf0: 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a 20 20 fexecutable]].
bc00: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
bc10: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 63 6c kage require tcl
bc20: 74 65 73 74 0a 09 70 61 63 6b 61 67 65 20 72 65 test..package re
bc30: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
bc40: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
bc50: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
bc60: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
bc70: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
bc80: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
bc90: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
bca0: 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c serverKey 8828 \
bcb0: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
bcc0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 ..proc accept {
bcd0: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 20 7d file addr port }
bce0: 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 66 {.. close $f
bcf0: 69 6c 65 0a 09 7d 0a 09 23 20 65 78 65 63 20 24 ile..}..# exec $
bd00: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
bd10: 73 74 20 73 63 72 69 70 74 31 20 26 0a 09 65 78 st script1 &..ex
bd20: 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 ec $tclsh script
bd30: 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 1 &..close $f..a
bd40: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
bd50: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
bd60: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
bd70: 0a 09 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 ... # Launch
bd80: 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 69 74 script2 and wait
bd90: 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 5 seconds..
bda0: 23 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 # exec $::tcltes
bdb0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
bdc0: 74 32 20 26 0a 20 20 20 20 65 78 65 63 20 5b 69 t2 &. exec [i
bdd0: 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 nfo nameofexecut
bde0: 61 62 6c 65 5d 20 73 63 72 69 70 74 32 20 26 0a able] script2 &.
bdf0: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 7b after 5000 {
be00: 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 set ok_to_proce
be10: 65 64 20 31 20 7d 0a 20 20 20 20 76 77 61 69 74 ed 1 }. vwait
be20: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a ok_to_proceed..
be30: 20 20 20 20 23 20 49 66 20 77 65 20 63 61 6e 20 # If we can
be40: 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f still connect to
be50: 20 74 68 65 20 73 65 72 76 65 72 2c 20 74 68 65 the server, the
be60: 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 socket got inhe
be70: 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b rited... if {
be80: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
be90: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
bea0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
beb0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
bec0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
bed0: 20 5c 0a 20 20 20 09 20 31 32 37 2e 30 2e 30 2e \. . 127.0.0.
bee0: 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 1 8828} msg]} {.
bef0: 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 .set x {server s
bf00: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
bf10: 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 20 65 herited}. } e
bf20: 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 lse {..close $ms
bf30: 67 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 g..set x {server
bf40: 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 socket was inhe
bf50: 72 69 74 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 rited}. }..
bf60: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
bf70: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
bf80: 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 20 ile script2.
bf90: 73 65 74 20 78 0a 7d 20 7b 73 65 72 76 65 72 20 set x.} {server
bfa0: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
bfb0: 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 nherited}..test
bfc0: 74 6c 73 49 4f 2d 31 32 2e 32 20 7b 74 65 73 74 tlsIO-12.2 {test
bfd0: 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 ing inheritance
bfe0: 6f 66 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 of client socket
bff0: 73 7d 20 5c 0a 09 7b 75 6e 65 78 70 6c 61 69 6e s} \..{unexplain
c000: 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 74 edFailure socket
c010: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
c020: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
c030: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
c040: 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c t1. removeFil
c050: 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 e script2.. #
c060: 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 Script1 is just
c070: 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c a 10 second del
c080: 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 ay. If the serv
c090: 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 er socket. #
c0a0: 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 is inherited, it
c0b0: 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 will be held op
c0c0: 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 en for 10 second
c0d0: 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 s.. set f [op
c0e0: 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 en script1 w].
c0f0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 puts $f {..aft
c100: 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 er 10000 exit..v
c110: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
c120: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
c130: 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 6f . # Script2 o
c140: 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 pens the client
c150: 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 socket and write
c160: 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 s to it. It the
c170: 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 n. # launches
c180: 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 script1 and exi
c190: 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c ts. If the chil
c1a0: 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 d process inheri
c1b0: 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c ted the. # cl
c1c0: 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 ient socket, the
c1d0: 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 socket will sti
c1e0: 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 ll be open...
c1f0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
c200: 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt2 w]. puts
c210: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
c220: 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 lsh [info nameof
c230: 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a 20 20 20 executable]].
c240: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
c250: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
c260: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
c270: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
c280: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
c290: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
c2a0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
c2b0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
c2c0: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
c2d0: 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 829 \]". puts
c2e0: 20 24 66 20 7b 0a 09 65 78 65 63 20 24 74 63 6c $f {..exec $tcl
c2f0: 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 70 75 sh script1 &..pu
c300: 74 73 20 24 66 20 74 65 73 74 69 6e 67 0a 09 66 ts $f testing..f
c310: 6c 75 73 68 20 24 66 0a 09 61 66 74 65 72 20 31 lush $f..after 1
c320: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
c330: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
c340: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
c350: 23 20 43 72 65 61 74 65 20 74 68 65 20 73 65 72 # Create the ser
c360: 76 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 ver socket..
c370: 73 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 3a set server [tls:
c380: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
c390: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
c3a0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
c3b0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
c3c0: 72 4b 65 79 20 5c 0a 09 2d 73 65 72 76 65 72 20 rKey \..-server
c3d0: 61 63 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 accept 8829].
c3e0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 proc accept { f
c3f0: 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 ile host port }
c400: 7b 0a 0a 09 23 20 57 68 65 6e 20 74 68 65 20 63 {...# When the c
c410: 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 lient connects,
c420: 65 73 74 61 62 6c 69 73 68 20 74 68 65 20 72 65 establish the re
c430: 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 ad handler..glob
c440: 61 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 al server..close
c450: 20 24 73 65 72 76 65 72 0a 09 66 69 6c 65 65 76 $server..fileev
c460: 65 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 62 ent $file readab
c470: 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 61 le [list getdata
c480: 20 24 66 69 6c 65 5d 0a 09 66 63 6f 6e 66 69 67 $file]..fconfig
c490: 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 66 65 ure $file -buffe
c4a0: 72 69 6e 67 20 6c 69 6e 65 20 2d 62 6c 6f 63 6b ring line -block
c4b0: 69 6e 67 20 30 0a 09 72 65 74 75 72 6e 0a 20 20 ing 0..return.
c4c0: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 67 65 74 }. proc get
c4d0: 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a data { file } {.
c4e0: 0a 09 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 ..# Read handler
c4f0: 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 65 64 on the accepted
c500: 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c socket...global
c510: 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 x..global faile
c520: 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b 63 d..set status [c
c530: 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 atch {read $file
c540: 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 } data]..if {$st
c550: 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 atus != 0} {..
c560: 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 66 61 set x {read fa
c570: 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 iled, error was
c580: 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 74 63 $data}.. catc
c590: 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 h { close $file
c5a0: 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 }..} elseif {[st
c5b0: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 ring compare {}
c5c0: 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 $data]} {..} els
c5d0: 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 eif {[fblocked $
c5e0: 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 file]} {..} else
c5f0: 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d if {[eof $file]}
c600: 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 69 {.. if {$fai
c610: 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b led} {...set x {
c620: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 client socket wa
c630: 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 s inherited}..
c640: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 } else {...set
c650: 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 x {client socke
c660: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
c670: 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 ted}.. }..
c680: 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 catch { close $
c690: 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b file }..} else {
c6a0: 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 6d 70 .. set x {imp
c6b0: 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 ossible case}..
c6c0: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
c6d0: 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 $file }..}..ret
c6e0: 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 urn. }.. #
c6f0: 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 64 If the socket d
c700: 6f 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f oesn't hit end-o
c710: 66 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 6f f-file in 5 seco
c720: 6e 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 73 nds, the. # s
c730: 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 6d cript1 process m
c740: 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 ust have inherit
c750: 65 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a ed the client...
c760: 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 set failed 0
c770: 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 . after 5000
c780: 5b 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 64 [list set failed
c790: 20 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 1].. # Launc
c7a0: 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 h the script2 pr
c7b0: 6f 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 20 ocess.. exec
c7c0: 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 [info nameofexec
c7d0: 75 74 61 62 6c 65 5d 20 73 63 72 69 70 74 32 20 utable] script2
c7e0: 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 &.. vwait x.
c7f0: 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 7d if {!$failed}
c800: 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 64 {..vwait failed
c810: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 6d 6f 76 . }. remov
c820: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
c830: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
c840: 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a 7d ipt2. set x.}
c850: 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 {client socket
c860: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
c870: 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 d}..test tlsIO-1
c880: 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 2.3 {testing inh
c890: 65 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 65 eritance of acce
c8a0: 70 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a pted sockets} \.
c8b0: 09 7b 68 61 6e 67 73 4f 6e 4c 69 6e 75 78 20 73 .{hangsOnLinux s
c8c0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
c8d0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
c8e0: 0a 20 20 20 20 23 20 68 61 6e 67 73 20 6f 6e 20 . # hangs on
c8f0: 4c 69 6e 75 78 0a 20 20 20 20 72 65 6d 6f 76 65 Linux. remove
c900: 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 File script1.
c910: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
c920: 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 5b pt2.. set f [
c930: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
c940: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
c950: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
c960: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
c970: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
c980: 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 f.. set f [op
c990: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
c9a0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
c9b0: 73 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 set tclsh [info
c9c0: 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 nameofexecutable
c9d0: 5d 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]]. puts $f {
c9e0: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
c9f0: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
ca00: 20 20 20 20 70 75 74 73 20 24 66 20 22 63 61 74 puts $f "cat
ca10: 63 68 20 7b 73 65 74 20 66 20 5c 5b 74 6c 73 3a ch {set f \[tls:
ca20: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
ca30: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
ca40: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
ca50: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
ca60: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
ca70: 20 38 39 33 30 20 5c 5d 7d 22 0a 20 20 20 20 70 8930 \]}". p
ca80: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
ca90: 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 ccept { file hos
caa0: 74 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 t port } {..
cab0: 67 6c 6f 62 61 6c 20 74 63 6c 73 68 0a 09 20 20 global tclsh..
cac0: 20 20 70 75 74 73 20 24 66 69 6c 65 20 7b 74 65 puts $file {te
cad0: 73 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 st data on socke
cae0: 74 7d 0a 09 20 20 20 20 65 78 65 63 20 24 74 63 t}.. exec $tc
caf0: 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 20 lsh script1 &..
cb00: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 65 78 after 1000 ex
cb10: 69 74 0a 09 7d 0a 09 63 61 74 63 68 20 7b 76 77 it..}..catch {vw
cb20: 61 69 74 20 66 6f 72 65 76 65 72 7d 0a 20 20 20 ait forever}.
cb30: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
cb40: 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 . # Launch th
cb50: 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 e script2 proces
cb60: 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f s and connect to
cb70: 20 69 74 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f it. See how lo
cb80: 6e 67 0a 20 20 20 20 23 20 74 68 65 20 73 6f 63 ng. # the soc
cb90: 6b 65 74 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a ket stays open..
cba0: 20 20 20 20 65 78 65 63 20 5b 69 6e 66 6f 20 6e exec [info n
cbb0: 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d ameofexecutable]
cbc0: 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 script2 &..
cbd0: 61 66 74 65 72 20 31 30 30 30 20 73 65 74 20 6f after 1000 set o
cbe0: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 k_to_proceed 1.
cbf0: 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 vwait ok_to_p
cc00: 72 6f 63 65 65 64 0a 0a 20 20 20 20 73 65 74 20 roceed.. set
cc10: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c f [tls::socket \
cc20: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
cc30: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
cc40: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
cc50: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
cc60: 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 \.. 127.0.0.1
cc70: 20 38 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 8930]. fconf
cc80: 69 67 75 72 65 20 24 66 20 2d 62 75 66 66 65 72 igure $f -buffer
cc90: 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 ing full -blocki
cca0: 6e 67 20 30 0a 20 20 20 20 66 69 6c 65 65 76 65 ng 0. fileeve
ccb0: 6e 74 20 24 66 20 72 65 61 64 61 62 6c 65 20 5b nt $f readable [
ccc0: 6c 69 73 74 20 67 65 74 64 61 74 61 20 24 66 5d list getdata $f]
ccd0: 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 .. # If the s
cce0: 6f 63 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 6f ocket is still o
ccf0: 70 65 6e 20 61 66 74 65 72 20 35 20 73 65 63 6f pen after 5 seco
cd00: 6e 64 73 2c 20 74 68 65 20 73 63 72 69 70 74 31 nds, the script1
cd10: 20 70 72 6f 63 65 73 73 0a 20 20 20 20 23 20 6d process. # m
cd20: 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 ust have inherit
cd30: 65 64 20 74 68 65 20 61 63 63 65 70 74 65 64 20 ed the accepted
cd40: 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 socket... set
cd50: 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 failed 0. af
cd60: 74 65 72 20 35 30 30 30 20 73 65 74 20 66 61 69 ter 5000 set fai
cd70: 6c 65 64 20 31 0a 0a 20 20 20 20 70 72 6f 63 20 led 1.. proc
cd80: 67 65 74 64 61 74 61 20 7b 20 66 69 6c 65 20 7d getdata { file }
cd90: 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 61 6e 64 {...# Read hand
cda0: 6c 65 72 20 6f 6e 20 74 68 65 20 63 6c 69 65 6e ler on the clien
cdb0: 74 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 t socket...globa
cdc0: 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c l x..global fail
cdd0: 65 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b ed..set status [
cde0: 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c catch {read $fil
cdf0: 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 e} data]..if {$s
ce00: 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 tatus != 0} {..
ce10: 20 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 66 set x {read f
ce20: 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 ailed, error was
ce30: 20 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 74 $data}.. cat
ce40: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
ce50: 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 }..} elseif {[s
ce60: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d tring compare {}
ce70: 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c $data]} {..} el
ce80: 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 seif {[fblocked
ce90: 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 $file]} {..} els
cea0: 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d eif {[eof $file]
ceb0: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 } {.. if {$fa
cec0: 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 iled} {...set x
ced0: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
cee0: 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a was inherited}.
cef0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
cf00: 73 65 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 set x {accepted
cf10: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
cf20: 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d nherited}.. }
cf30: 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c .. catch { cl
cf40: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 ose $file }..} e
cf50: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 lse {.. set x
cf60: 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 {impossible cas
cf70: 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 e}.. catch {
cf80: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d close $file }..}
cf90: 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 ..return. }.
cfa0: 20 20 20 0a 20 20 20 20 76 77 61 69 74 20 78 0a . vwait x.
cfb0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
cfc0: 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f script1. remo
cfd0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 veFile script2.
cfe0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 set x.} {acce
cff0: 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 pted socket was
d000: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
d010: 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 test tlsIO-13.1
d020: 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 20 {Testing use of
d030: 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 65 shared socket be
d040: 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 64 tween two thread
d050: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 s} \..{socket te
d060: 73 74 74 68 72 65 61 64 7d 20 7b 0a 0a 20 20 20 stthread} {..
d070: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
d080: 70 74 0a 20 20 20 20 74 68 72 65 61 64 52 65 61 pt. threadRea
d090: 70 0a 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 p.. makeFile
d0a0: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
d0b0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
d0c0: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
d0d0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
d0e0: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
d0f0: 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 {s a p} {.
d100: 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 fileevent
d110: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
d120: 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 st echo $s].
d130: 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 fconfigu
d140: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
d150: 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a line. }.
d160: 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b .proc echo {s} {
d170: 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a .. global i.
d180: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
d190: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
d1a0: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
d1b0: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
d1c0: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
d1d0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
d1e0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
d1f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
d200: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
d210: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 } else {
d220: 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 .. incr
d230: 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
d240: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
d250: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a }..}.
d260: 09 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 20 .set i 0..vwait
d270: 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 x..close $f...#
d280: 74 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 74 thread cleans it
d290: 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 68 self up...testth
d2a0: 72 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d 20 read exit. }
d2b0: 73 63 72 69 70 74 0a 20 20 20 20 0a 20 20 20 20 script. .
d2c0: 23 20 63 72 65 61 74 65 20 61 20 74 68 72 65 61 # create a threa
d2d0: 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 d. set server
d2e0: 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 thread [testthre
d2f0: 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 ad create { sour
d300: 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 ce script } ].
d310: 20 20 75 70 64 61 74 65 0a 20 20 20 20 0a 20 20 update. .
d320: 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 after 1000.
d330: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
d340: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 ket 127.0.0.1 88
d350: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
d360: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
d370: 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 line.. catch
d380: 20 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 6c {..puts $s "hel
d390: 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 73 lo"..gets $s res
d3a0: 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ult. }. cl
d3b0: 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 ose $s. updat
d3c0: 65 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 e.. after 200
d3d0: 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 0. lappend re
d3e0: 73 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 70 sult [threadReap
d3f0: 5d 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 72 ]. . set r
d400: 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 esult..} {hello
d410: 31 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 66 1}..# cleanup.if
d420: 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 {[string match
d430: 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f sock* $commandSo
d440: 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 cket] == 1} {.
d450: 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f puts $commandSo
d460: 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 6c 75 cket exit. flu
d470: 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 sh $commandSocke
d480: 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 t.}.catch {close
d490: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d $commandSocket}
d4a0: 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 72 .catch {close $r
d4b0: 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a 3a emoteProcChan}.:
d4c0: 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e 75 :tcltest::cleanu
d4d0: 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 74 64 pTests.flush std
d4e0: 6f 75 74 0a 72 65 74 75 72 6e 0a 0a out.return..