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 31 20 32 30 30 30 2f 30 37 2f .14.2.1 2000/07/
0210: 31 31 20 30 34 3a 35 38 3a 34 36 20 68 6f 62 62 11 04:58:46 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 23 73 65 74 t]] certs] .#set
0c00: 20 63 65 72 74 73 44 69 72 20 7e 68 6f 62 62 73 certsDir ~hobbs
0c10: 2f 63 76 73 2f 74 6c 73 2f 74 65 73 74 73 2f 63 /cvs/tls/tests/c
0c20: 65 72 74 73 0a 0a 73 65 74 20 73 65 72 76 65 72 erts..set server
0c30: 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 Cert [file join
0c40: 24 63 65 72 74 73 44 69 72 20 73 65 72 76 65 72 $certsDir server
0c50: 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e 74 .pem].set client
0c60: 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 Cert [file join
0c70: 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 6e 74 $certsDir client
0c80: 2e 70 65 6d 5d 0a 73 65 74 20 63 61 43 65 72 74 .pem].set caCert
0c90: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 [file join $cer
0ca0: 74 73 44 69 72 20 63 61 63 65 72 74 2e 70 65 6d tsDir cacert.pem
0cb0: 5d 0a 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 ].set serverKey
0cc0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
0cd0: 73 44 69 72 20 73 6b 65 79 2e 70 65 6d 5d 0a 73 sDir skey.pem].s
0ce0: 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 5b 66 69 et clientKey [fi
0cf0: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
0d00: 72 20 63 6b 65 79 2e 70 65 6d 5d 0a 0a 23 20 53 r ckey.pem]..# S
0d10: 6f 6d 65 20 74 65 73 74 73 20 72 65 71 75 69 72 ome tests requir
0d20: 65 20 74 68 65 20 74 65 73 74 74 68 72 65 61 64 e the testthread
0d30: 20 63 6f 6d 6d 61 6e 64 0a 0a 73 65 74 20 3a 3a command..set ::
0d40: 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e tcltest::testCon
0d50: 73 74 72 61 69 6e 74 73 28 74 65 73 74 74 68 72 straints(testthr
0d60: 65 61 64 29 20 5c 0a 09 5b 65 78 70 72 20 7b 5b ead) \..[expr {[
0d70: 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 74 65 info commands te
0d80: 73 74 74 68 72 65 61 64 5d 20 21 3d 20 7b 7d 7d stthread] != {}}
0d90: 5d 0a 0a 23 0a 23 20 49 66 20 72 65 6d 6f 74 65 ]..#.# If remote
0da0: 53 65 72 76 65 72 49 50 20 6f 72 20 72 65 6d 6f ServerIP or remo
0db0: 74 65 53 65 72 76 65 72 50 6f 72 74 20 61 72 65 teServerPort are
0dc0: 20 6e 6f 74 20 73 65 74 2c 20 63 68 65 63 6b 20 not set, check
0dd0: 69 6e 20 74 68 65 0a 23 20 65 6e 76 69 72 6f 6e in the.# environ
0de0: 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 20 66 ment variables f
0df0: 6f 72 20 65 78 74 65 72 6e 61 6c 6c 79 20 73 65 or externally se
0e00: 74 20 76 61 6c 75 65 73 2e 0a 23 0a 0a 69 66 20 t values..#..if
0e10: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 {![info exists r
0e20: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 7d 20 emoteServerIP]}
0e30: 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 {. if {[info
0e40: 65 78 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 exists env(remot
0e50: 65 53 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 eServerIP)]} {..
0e60: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
0e70: 49 50 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 IP $env(remoteSe
0e80: 72 76 65 72 49 50 29 0a 20 20 20 20 7d 0a 7d 0a rverIP). }.}.
0e90: 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 if {![info exist
0ea0: 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f s remoteServerPo
0eb0: 72 74 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b rt]} {. if {[
0ec0: 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 info exists env(
0ed0: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
0ee0: 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 )]} {..set remot
0ef0: 65 53 65 72 76 65 72 50 6f 72 74 20 24 65 6e 76 eServerPort $env
0f00: 28 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 (remoteServerPor
0f10: 74 29 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a t). } else {.
0f20: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 69 6e 66 if {[inf
0f30: 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 o exists remoteS
0f40: 65 72 76 65 72 49 50 5d 7d 20 7b 0a 09 20 20 20 erverIP]} {..
0f50: 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 set remoteServe
0f60: 72 50 6f 72 74 20 24 74 6c 73 53 65 72 76 65 72 rPort $tlsServer
0f70: 50 6f 72 74 0a 20 20 20 20 20 20 20 20 7d 0a 20 Port. }.
0f80: 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 }.}..#.# Chec
0f90: 6b 20 69 66 20 77 65 27 72 65 20 73 75 70 70 6f k if we're suppo
0fa0: 73 65 64 20 74 6f 20 64 6f 20 74 65 73 74 73 20 sed to do tests
0fb0: 61 67 61 69 6e 73 74 20 74 68 65 20 72 65 6d 6f against the remo
0fc0: 74 65 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 te server.#..set
0fd0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
0fe0: 74 65 53 65 72 76 65 72 20 31 0a 69 66 20 7b 21 teServer 1.if {!
0ff0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
1000: 6f 74 65 53 65 72 76 65 72 49 50 5d 20 26 26 20 oteServerIP] &&
1010: 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 ($tcl_platform(p
1020: 6c 61 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 latform) != "mac
1030: 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 intosh")} {.
1040: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
1050: 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 IP 127.0.0.1.}.i
1060: 66 20 7b 28 24 64 6f 54 65 73 74 73 57 69 74 68 f {($doTestsWith
1070: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 RemoteServer ==
1080: 31 29 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 1) && (![info ex
1090: 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 ists remoteServe
10a0: 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 rPort])} {. s
10b0: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 et remoteServerP
10c0: 6f 72 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f ort $tlsServerPo
10d0: 72 74 0a 7d 0a 0a 23 20 41 74 74 65 6d 70 74 20 rt.}..# Attempt
10e0: 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 20 61 20 to connect to a
10f0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 69 66 remote server if
1100: 20 6f 6e 65 20 69 73 20 61 6c 72 65 61 64 79 20 one is already
1110: 72 75 6e 6e 69 6e 67 2e 20 49 66 20 69 74 0a 23 running. If it.#
1120: 20 69 73 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 is not running
1130: 6f 72 20 66 6f 72 20 73 6f 6d 65 20 6f 74 68 65 or for some othe
1140: 72 20 72 65 61 73 6f 6e 20 74 68 65 20 63 6f 6e r reason the con
1150: 6e 65 63 74 20 66 61 69 6c 73 2c 20 61 74 74 65 nect fails, atte
1160: 6d 70 74 20 74 6f 0a 23 20 73 74 61 72 74 20 74 mpt to.# start t
1170: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
1180: 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f on the local ho
1190: 73 74 20 6c 69 73 74 65 6e 69 6e 67 20 6f 6e 20 st listening on
11a0: 70 6f 72 74 20 38 30 34 38 2e 20 54 68 69 73 0a port 8048. This.
11b0: 23 20 69 73 20 6f 6e 6c 79 20 64 6f 6e 65 20 6f # is only done o
11c0: 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 n platforms that
11d0: 20 73 75 70 70 6f 72 74 20 65 78 65 63 20 28 69 support exec (i
11e0: 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 68 65 20 4d .e. not on the M
11f0: 61 63 29 2e 20 4f 6e 0a 23 20 70 6c 61 74 66 6f ac). On.# platfo
1200: 72 6d 73 20 74 68 61 74 20 64 6f 20 6e 6f 74 20 rms that do not
1210: 73 75 70 70 6f 72 74 20 65 78 65 63 2c 20 74 68 support exec, th
1220: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 e remote server
1230: 6d 75 73 74 20 62 65 20 73 74 61 72 74 65 64 0a must be started.
1240: 23 20 62 79 20 74 68 65 20 75 73 65 72 20 62 65 # by the user be
1250: 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 fore running the
1260: 20 74 65 73 74 73 2e 0a 0a 73 65 74 20 72 65 6d tests...set rem
1270: 6f 74 65 50 72 6f 63 43 68 61 6e 20 22 22 0a 73 oteProcChan "".s
1280: 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 et commandSocket
1290: 20 22 22 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 "".if {$doTests
12a0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
12b0: 7d 20 7b 0a 20 20 20 20 63 61 74 63 68 20 7b 63 } {. catch {c
12c0: 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 lose $commandSoc
12d0: 6b 65 74 7d 0a 20 20 20 20 69 66 20 7b 5b 63 61 ket}. if {[ca
12e0: 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 tch {set command
12f0: 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 Socket [tls::soc
1300: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
1310: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
1320: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
1330: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
1340: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
1350: 6f 74 65 53 65 72 76 65 72 49 50 20 5c 0a 09 20 oteServerIP \..
1360: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
1370: 50 6f 72 74 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a Port]}] != 0} {.
1380: 09 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 .if {[info comma
1390: 6e 64 73 20 65 78 65 63 5d 20 3d 3d 20 22 22 7d nds exec] == ""}
13a0: 20 7b 0a 09 20 20 20 20 73 65 74 20 6e 6f 52 65 {.. set noRe
13b0: 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 22 moteTestReason "
13c0: 63 61 6e 27 74 20 65 78 65 63 22 0a 09 20 20 20 can't exec"..
13d0: 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 set doTestsWith
13e0: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 RemoteServer 0..
13f0: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 } else {.. se
1400: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 t remoteServerIP
1410: 20 31 32 37 2e 30 2e 30 2e 31 0a 09 20 20 20 20 127.0.0.1..
1420: 73 65 74 20 72 65 6d 6f 74 65 46 69 6c 65 20 5b set remoteFile [
1430: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
1440: 72 65 6d 6f 74 65 2e 74 63 6c 5d 0a 09 20 20 20 remote.tcl]..
1450: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 if {[catch {set
1460: 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 remoteProcChan
1470: 5c 0a 09 09 09 09 5b 6f 70 65 6e 20 22 7c 5b 6c \.....[open "|[l
1480: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
1490: 74 63 6c 74 65 73 74 20 24 72 65 6d 6f 74 65 46 tcltest $remoteF
14a0: 69 6c 65 20 5c 0a 09 09 09 09 09 2d 73 65 72 76 ile \......-serv
14b0: 65 72 49 73 53 69 6c 65 6e 74 20 5c 0a 09 09 09 erIsSilent \....
14c0: 09 09 2d 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 ..-port $remoteS
14d0: 65 72 76 65 72 50 6f 72 74 20 5c 0a 09 09 09 09 erverPort \.....
14e0: 09 2d 61 64 64 72 65 73 73 20 24 72 65 6d 6f 74 .-address $remot
14f0: 65 53 65 72 76 65 72 49 50 5d 22 20 5c 0a 09 09 eServerIP]" \...
1500: 09 09 09 77 2b 5d 7d 20 5c 0a 09 09 20 20 20 6d ...w+]} \... m
1510: 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 61 66 sg] == 0} {...af
1520: 74 65 72 20 31 30 30 30 0a 09 09 69 66 20 7b 5b ter 1000...if {[
1530: 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 catch {set comma
1540: 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 ndSocket [tls::s
1550: 6f 63 6b 65 74 20 5c 0a 09 09 20 20 20 20 2d 63 ocket \... -c
1560: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
1570: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
1580: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
1590: 69 65 6e 74 4b 65 79 20 5c 0a 09 09 09 09 24 72 ientKey \.....$r
15a0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 5c 0a emoteServerIP \.
15b0: 09 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 65 ....$remoteServe
15c0: 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 20 3d 3d 20 rPort]} msg] ==
15d0: 30 7d 20 7b 0a 09 09 20 20 20 20 66 63 6f 6e 66 0} {... fconf
15e0: 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f igure $commandSo
15f0: 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f cket -translatio
1600: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
1610: 67 20 6c 69 6e 65 0a 09 09 7d 20 65 6c 73 65 20 g line...} else
1620: 7b 0a 09 09 20 20 20 20 73 65 74 20 6e 6f 52 65 {... set noRe
1630: 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 24 moteTestReason $
1640: 6d 73 67 0a 09 09 20 20 20 20 73 65 74 20 64 6f msg... set do
1650: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1660: 65 72 76 65 72 20 30 0a 09 09 7d 0a 09 20 20 20 erver 0...}..
1670: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 } else {...set
1680: 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 noRemoteTestReas
1690: 6f 6e 20 22 24 6d 73 67 20 24 3a 3a 74 63 6c 74 on "$msg $::tclt
16a0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 22 0a 09 09 est::tcltest"...
16b0: 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 set doTestsWithR
16c0: 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 20 emoteServer 0..
16d0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 20 65 6c }..}. } el
16e0: 73 65 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 se {..fconfigure
16f0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
1700: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
1710: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
1720: 65 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 53 6f 6d e. }.}..# Som
1730: 65 20 74 65 73 74 73 20 61 72 65 20 72 75 6e 20 e tests are run
1740: 6f 6e 6c 79 20 69 66 20 77 65 20 61 72 65 20 64 only if we are d
1750: 6f 69 6e 67 20 74 65 73 74 69 6e 67 20 61 67 61 oing testing aga
1760: 69 6e 73 74 20 61 20 72 65 6d 6f 74 65 20 73 65 inst a remote se
1770: 72 76 65 72 2e 0a 73 65 74 20 3a 3a 74 63 6c 74 rver..set ::tclt
1780: 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 est::testConstra
1790: 69 6e 74 73 28 64 6f 54 65 73 74 73 57 69 74 68 ints(doTestsWith
17a0: 52 65 6d 6f 74 65 53 65 72 76 65 72 29 20 24 64 RemoteServer) $d
17b0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
17c0: 53 65 72 76 65 72 0a 69 66 20 7b 24 64 6f 54 65 Server.if {$doTe
17d0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
17e0: 76 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 ver == 0} {.
17f0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 if {[string firs
1800: 74 20 73 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a t s $::tcltest::
1810: 76 65 72 62 6f 73 65 5d 20 21 3d 20 2d 31 7d 20 verbose] != -1}
1820: 7b 0a 20 20 20 20 09 70 75 74 73 20 22 53 6b 69 {. .puts "Ski
1830: 70 70 69 6e 67 20 74 65 73 74 73 20 77 69 74 68 pping tests with
1840: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 20 remote server.
1850: 53 65 65 20 74 65 73 74 73 2f 73 6f 63 6b 65 74 See tests/socket
1860: 2e 74 65 73 74 20 66 6f 72 22 0a 09 70 75 74 73 .test for"..puts
1870: 20 22 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e "information on
1880: 20 68 6f 77 20 74 6f 20 72 75 6e 20 72 65 6d 6f how to run remo
1890: 74 65 20 73 65 72 76 65 72 2e 22 0a 09 70 75 74 te server."..put
18a0: 73 20 22 52 65 61 73 6f 6e 20 66 6f 72 20 6e 6f s "Reason for no
18b0: 74 20 64 6f 69 6e 67 20 72 65 6d 6f 74 65 20 74 t doing remote t
18c0: 65 73 74 73 3a 20 24 6e 6f 52 65 6d 6f 74 65 54 ests: $noRemoteT
18d0: 65 73 74 52 65 61 73 6f 6e 22 0a 20 20 20 20 7d estReason". }
18e0: 0a 7d 0a 0a 23 0a 23 20 49 66 20 77 65 20 64 6f .}..#.# If we do
18f0: 20 74 68 65 20 74 65 73 74 73 2c 20 64 65 66 69 the tests, defi
1900: 6e 65 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 ne a command to
1910: 73 65 6e 64 20 61 20 63 6f 6d 6d 61 6e 64 20 74 send a command t
1920: 6f 20 74 68 65 0a 23 20 72 65 6d 6f 74 65 20 73 o the.# remote s
1930: 65 72 76 65 72 2e 0a 23 0a 0a 69 66 20 7b 24 64 erver..#..if {$d
1940: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
1950: 53 65 72 76 65 72 20 3d 3d 20 31 7d 20 7b 0a 20 Server == 1} {.
1960: 20 20 20 70 72 6f 63 20 73 65 6e 64 43 6f 6d 6d proc sendComm
1970: 61 6e 64 20 7b 63 7d 20 7b 0a 09 67 6c 6f 62 61 and {c} {..globa
1980: 6c 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a l commandSocket.
1990: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d ..if {[eof $comm
19a0: 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 20 andSocket]} {..
19b0: 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 error "remote
19c0: 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 server disappea
19d0: 72 65 64 22 0a 09 7d 0a 0a 09 69 66 20 7b 5b 63 red"..}...if {[c
19e0: 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d atch {puts $comm
19f0: 61 6e 64 53 6f 63 6b 65 74 20 24 63 7d 20 6d 73 andSocket $c} ms
1a00: 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 g]} {.. error
1a10: 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 "remote server
1a20: 64 69 73 61 70 70 61 65 72 65 64 3a 20 24 6d 73 disappaered: $ms
1a30: 67 22 0a 09 7d 0a 09 69 66 20 7b 5b 63 61 74 63 g"..}..if {[catc
1a40: 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 h {puts $command
1a50: 53 6f 63 6b 65 74 20 22 2d 2d 4d 61 72 6b 65 72 Socket "--Marker
1a60: 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 --Marker--Marker
1a70: 2d 2d 22 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 --"} msg]} {..
1a80: 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 error "remote
1a90: 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 server disappear
1aa0: 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 0a 09 73 ed: $msg"..}...s
1ab0: 65 74 20 72 65 73 70 20 22 22 0a 09 77 68 69 6c et resp ""..whil
1ac0: 65 20 7b 31 7d 20 7b 0a 09 20 20 20 20 73 65 74 e {1} {.. set
1ad0: 20 6c 69 6e 65 20 5b 67 65 74 73 20 24 63 6f 6d line [gets $com
1ae0: 6d 61 6e 64 53 6f 63 6b 65 74 5d 0a 09 20 20 20 mandSocket]..
1af0: 20 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 if {[eof $comma
1b00: 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 09 65 ndSocket]} {...e
1b10: 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 rror "remote ser
1b20: 76 65 72 20 64 69 73 61 70 70 65 61 72 65 64 22 ver disappeared"
1b30: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 .. }.. if
1b40: 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 {[string compare
1b50: 20 24 6c 69 6e 65 20 22 2d 2d 4d 61 72 6b 65 72 $line "--Marker
1b60: 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 --Marker--Marker
1b70: 2d 2d 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 69 --"] == 0} {...i
1b80: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
1b90: 72 65 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 re [lindex $resp
1ba0: 20 30 5d 20 65 72 72 6f 72 5d 20 3d 3d 20 30 7d 0] error] == 0}
1bb0: 20 7b 0a 09 09 20 20 20 20 65 72 72 6f 72 20 5b {... error [
1bc0: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a lindex $resp 1].
1bd0: 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 ..} else {...
1be0: 20 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 78 20 return [lindex
1bf0: 24 72 65 73 70 20 31 5d 0a 09 09 7d 0a 09 20 20 $resp 1]...}..
1c00: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 61 70 70 } else {...app
1c10: 65 6e 64 20 72 65 73 70 20 24 6c 69 6e 65 20 22 end resp $line "
1c20: 5c 6e 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 \n".. }..}.
1c30: 20 20 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 }.}..test tlsI
1c40: 4f 2d 31 2e 31 20 7b 61 72 67 20 70 61 72 73 69 O-1.1 {arg parsi
1c50: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1c60: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1c70: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1c80: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1c90: 73 65 72 76 65 72 7d 20 6d 73 67 5d 20 24 6d 73 server} msg] $ms
1ca0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
1cb0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
1cc0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
1cd0: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
1ce0: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
1cf0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 32 20 7b test tlsIO-1.2 {
1d00: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
1d10: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
1d20: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
1d30: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
1d40: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
1d50: 66 6f 6f 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d foo} msg] $msg.}
1d60: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
1d70: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
1d80: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
1d90: 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f r command ?optio
1da0: 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ns? port"}}..tes
1db0: 74 20 74 6c 73 49 4f 2d 31 2e 33 20 7b 61 72 67 t tlsIO-1.3 {arg
1dc0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
1dd0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
1de0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
1df0: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
1e00: 63 6b 65 74 20 2d 6d 79 61 64 64 72 7d 20 6d 73 cket -myaddr} ms
1e10: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
1e20: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
1e30: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
1e40: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
1e50: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
1e60: 74 6c 73 49 4f 2d 31 2e 34 20 7b 61 72 67 20 70 tlsIO-1.4 {arg p
1e70: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
1e80: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
1e90: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
1ea0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
1eb0: 65 74 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 et -myaddr 127.0
1ec0: 2e 30 2e 31 7d 20 6d 73 67 5d 20 24 6d 73 67 0a .0.1} msg] $msg.
1ed0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
1ee0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
1ef0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
1f00: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
1f10: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
1f20: 35 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 5 {arg parsing f
1f30: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
1f40: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
1f50: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
1f60: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f ls::socket -mypo
1f70: 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 rt} msg] $msg.}
1f80: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
1f90: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
1fa0: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
1fb0: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
1fc0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 36 20 .test tlsIO-1.6
1fd0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
1fe0: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
1ff0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2000: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2010: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 ::socket -myport
2020: 20 78 78 78 78 7d 20 6d 73 67 5d 20 24 6d 73 67 xxxx} msg] $msg
2030: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
2040: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
2050: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
2060: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
2070: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
2080: 2e 37 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .7 {arg parsing
2090: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
20a0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
20b0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
20c0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 tls::socket -myp
20d0: 6f 72 74 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 ort 2522} msg] $
20e0: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
20f0: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2100: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2110: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2120: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2130: 4f 2d 31 2e 38 20 7b 61 72 67 20 70 61 72 73 69 O-1.8 {arg parsi
2140: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2150: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
2160: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
2170: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2180: 66 72 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 froboz} msg] $ms
2190: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
21a0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
21b0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
21c0: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
21d0: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
21e0: 31 2e 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.9 {arg parsing
21f0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2200: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2210: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2220: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2230: 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 rver foo -myport
2240: 20 32 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 2521 3333} msg]
2250: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
2260: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
2270: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
2280: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
2290: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
22a0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
22b0: 2e 31 30 20 7b 61 72 67 20 70 61 72 73 69 6e 67 .10 {arg parsing
22c0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
22d0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
22e0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
22f0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 {tls::socket hos
2300: 74 20 32 35 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 t 2528 -junk} ms
2310: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2320: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2330: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2340: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2350: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
2360: 74 6c 73 49 4f 2d 31 2e 31 31 20 7b 61 72 67 20 tlsIO-1.11 {arg
2370: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
2380: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2390: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
23a0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
23b0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 61 6c 6c ket -server call
23c0: 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d 20 6d 73 back 2520 --} ms
23d0: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
23e0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
23f0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2400: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
2410: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
2420: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
2430: 2d 31 2e 31 32 20 7b 61 72 67 20 70 61 72 73 69 -1.12 {arg parsi
2440: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2450: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
2460: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
2470: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 66 h {tls::socket f
2480: 6f 6f 20 62 61 64 70 6f 72 74 7d 20 6d 73 67 5d oo badport} msg]
2490: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 65 78 70 65 $msg.} {1 {expe
24a0: 63 74 65 64 20 69 6e 74 65 67 65 72 20 62 75 74 cted integer but
24b0: 20 67 6f 74 20 22 62 61 64 70 6f 72 74 22 7d 7d got "badport"}}
24c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 ..test tlsIO-2.1
24d0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
24e0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
24f0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
2500: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
2510: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
2520: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
2530: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
2540: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
2550: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
2560: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
2570: 74 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 t"]. }. pu
2580: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
2590: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
25a0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
25b0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
25c0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
25d0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
25e0: 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 Key 8828 \]".
25f0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
2600: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 accept {file ad
2610: 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 dr port} {..
2620: 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 global x.. se
2630: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
2640: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 close $file
2650: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
2660: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
2670: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
2680: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 lose $f..puts $x
2690: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
26a0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
26b0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
26c0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
26d0: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
26e0: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
26f0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
2700: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
2710: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
2720: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
2730: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
2740: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 ey 127.0.0.1 882
2750: 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 8} msg]} {.
2760: 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 set x $msg.
2770: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
2780: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
2790: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
27a0: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
27b0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
27c0: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
27d0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
27e0: 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d {ready done {}}
27f0: 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 ..if [info exist
2800: 73 20 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e s port] {. in
2810: 63 72 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b cr port.} else {
2820: 20 0a 20 20 20 20 73 65 74 20 70 6f 72 74 20 5b . set port [
2830: 65 78 70 72 20 24 74 6c 73 53 65 72 76 65 72 50 expr $tlsServerP
2840: 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 ort + [pid]%1024
2850: 5d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ].}..test tlsIO-
2860: 32 2e 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.2 {tcp connect
2870: 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 ion with client
2880: 70 6f 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 port specified}
2890: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
28a0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
28b0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
28c0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
28d0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
28e0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
28f0: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
2900: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
2910: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 x done"]. }.
2920: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
2930: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
2940: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
2950: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
2960: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
2970: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
2980: 65 72 76 65 72 4b 65 79 20 38 38 32 39 20 5c 5d erverKey 8829 \]
2990: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
29a0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
29b0: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
29c0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
29d0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
29e0: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 puts "[gets $fi
29f0: 6c 65 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 20 le] $port".
2a00: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 close $fi
2a10: 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 le. s
2a20: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
2a30: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
2a40: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
2a50: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
2a60: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
2a70: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
2a80: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
2a90: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
2aa0: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
2ab0: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 67 6c gets $f x. gl
2ac0: 6f 62 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 obal port. if
2ad0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
2ae0: 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 ocket -myport $p
2af0: 6f 72 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ort \..-certfile
2b00: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
2b10: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
2b20: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
2b30: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 Key 127.0.0.1 88
2b40: 32 39 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 29} sock]} {.
2b50: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
2b60: 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b ..catch {close [
2b70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
2b80: 30 2e 30 2e 31 20 38 38 32 39 5d 7d 0a 20 20 20 0.0.1 8829]}.
2b90: 20 7d 20 65 6c 73 65 20 7b 0a 09 23 20 48 4f 42 } else {..# HOB
2ba0: 42 53 20 68 61 6e 64 73 68 61 6b 65 20 73 68 6f BS handshake sho
2bb0: 75 6c 64 6e 27 74 20 62 65 20 6e 65 63 65 73 73 uldn't be necess
2bc0: 61 72 79 0a 09 74 6c 73 3a 3a 68 61 6e 64 73 68 ary..tls::handsh
2bd0: 61 6b 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ake $sock.
2be0: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
2bf0: 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a lo..flush $sock.
2c00: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
2c10: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
2c20: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
2c30: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
2c40: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 5b $f. set x.} [
2c50: 6c 69 73 74 20 72 65 61 64 79 20 22 68 65 6c 6c list ready "hell
2c60: 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 o $port"]..test
2c70: 74 6c 73 49 4f 2d 32 2e 33 20 7b 74 63 70 20 63 tlsIO-2.3 {tcp c
2c80: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 onnection with c
2c90: 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 63 65 20 lient interface
2ca0: 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b specified} {sock
2cb0: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
2cc0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
2cd0: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
2ce0: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
2cf0: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
2d00: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
2d10: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
2d20: 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 2000 "set x don
2d30: 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 e"]. }. pu
2d40: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
2d50: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2d60: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
2d70: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
2d80: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2d90: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
2da0: 4b 65 79 20 38 38 33 30 20 5c 5d 22 0a 20 20 20 Key 8830 \]".
2db0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
2dc0: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 accept {file ad
2dd0: 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 dr port} {.
2de0: 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a global x.
2df0: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
2e00: 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 20 24 "[gets $file] $
2e10: 61 64 64 72 22 0a 20 20 20 20 20 20 20 20 20 20 addr".
2e20: 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 close $file.
2e30: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
2e40: 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 done..}..puts re
2e50: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
2e60: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
2e70: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 r..close $f.
2e80: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
2e90: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
2ea0: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
2eb0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
2ec0: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
2ed0: 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 $f x. if {[ca
2ee0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2ef0: 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 -myaddr 127.0.0
2f00: 2e 31 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 .1 \..-certfile
2f10: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
2f20: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
2f30: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
2f40: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 ey 127.0.0.1 883
2f50: 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 0} sock]} {.
2f60: 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a set x $sock.
2f70: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 23 20 } else {..#
2f80: 48 4f 42 42 53 20 68 61 6e 64 73 68 61 6b 65 20 HOBBS handshake
2f90: 73 68 6f 75 6c 64 6e 27 74 20 62 65 20 6e 65 63 shouldn't be nec
2fa0: 65 73 73 61 72 79 0a 09 74 6c 73 3a 3a 68 61 6e essary..tls::han
2fb0: 64 73 68 61 6b 65 20 24 73 6f 63 6b 0a 20 20 20 dshake $sock.
2fc0: 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 puts $sock
2fd0: 68 65 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c hello..catch {fl
2fe0: 75 73 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 ush $sock}.
2ff0: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
3000: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
3010: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
3020: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3030: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
3040: 20 7b 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e {hello 127.0.0.
3050: 31 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 1}}..test tlsIO-
3060: 32 2e 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.4 {tcp connect
3070: 69 6f 6e 20 77 69 74 68 20 73 65 72 76 65 72 20 ion with server
3080: 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 66 interface specif
3090: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ied} {socket std
30a0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
30b0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
30c0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
30d0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
30e0: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
30f0: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
3100: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
3110: 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 "set x done"].
3120: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
3130: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
3140: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
3150: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
3160: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
3170: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
3180: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 2d 6d le $serverKey -m
3190: 79 61 64 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 yaddr [info host
31a0: 6e 61 6d 65 5d 20 38 38 33 31 20 5c 5d 22 0a 20 name] 8831 \]".
31b0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
31c0: 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 oc accept {file
31d0: 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 addr port} {.
31e0: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
31f0: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 x. pu
3200: 74 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d ts "[gets $file]
3210: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
3220: 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 ose $file.
3230: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
3240: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
3250: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
3260: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
3270: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
3280: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3290: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
32a0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
32b0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
32c0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
32d0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
32e0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 {tls::socket -ce
32f0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
3300: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3310: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
3320: 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 clientKey [info
3330: 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 7d 20 hostname] 8831}
3340: 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 sock]} {.
3350: 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 set x $sock.
3360: 20 7d 20 65 6c 73 65 20 7b 0a 09 23 20 48 4f 42 } else {..# HOB
3370: 42 53 20 68 61 6e 64 73 68 61 6b 65 20 73 68 6f BS handshake sho
3380: 75 6c 64 6e 27 74 20 62 65 20 6e 65 63 65 73 73 uldn't be necess
3390: 61 72 79 0a 09 74 6c 73 3a 3a 68 61 6e 64 73 68 ary..tls::handsh
33a0: 61 6b 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ake $sock.
33b0: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
33c0: 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a lo..flush $sock.
33d0: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
33e0: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
33f0: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
3400: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
3410: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
3420: 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 ready hello}..te
3430: 73 74 20 74 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 st tlsIO-2.5 {tc
3440: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 p connection wit
3450: 68 20 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 h redundant serv
3460: 65 72 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 er port} {socket
3470: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
3480: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
3490: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
34a0: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
34b0: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
34c0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
34d0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
34e0: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
34f0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
3500: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
3510: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
3520: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
3530: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
3540: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
3550: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
3560: 79 20 38 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 y 8832 \]". p
3570: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
3580: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
3590: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
35a0: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
35b0: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
35c0: 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 [gets $file]".
35d0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
35e0: 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 $file.
35f0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a set x done..}.
3600: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
3610: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
3620: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
3630: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
3640: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
3650: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
3660: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
3670: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
3680: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
3690: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
36a0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
36b0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
36c0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
36d0: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
36e0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
36f0: 38 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 8832} sock]} {.
3700: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f set x $so
3710: 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ck. } else {.
3720: 09 23 20 48 4f 42 42 53 20 68 61 6e 64 73 68 61 .# HOBBS handsha
3730: 6b 65 20 73 68 6f 75 6c 64 6e 27 74 20 62 65 20 ke shouldn't be
3740: 6e 65 63 65 73 73 61 72 79 0a 09 74 6c 73 3a 3a necessary..tls::
3750: 68 61 6e 64 73 68 61 6b 65 20 24 73 6f 63 6b 0a handshake $sock.
3760: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
3770: 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 ck hello..flush
3780: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 $sock. la
3790: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
37a0: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
37b0: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
37c0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
37d0: 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c x.} {ready hell
37e0: 6f 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e o}.test tlsIO-2.
37f0: 36 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6 {tcp connectio
3800: 6e 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 n} {socket} {.
3810: 20 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a set status ok.
3820: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
3830: 7b 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a {set sock [tls::
3840: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
3850: 20 38 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 8833]}]} {..if
3860: 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 {![catch {gets $
3870: 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 sock}]} {.. s
3880: 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e et status broken
3890: 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b ..}..close $sock
38a0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
38b0: 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 tatus.} ok..test
38c0: 20 74 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 68 6f tlsIO-2.7 {echo
38d0: 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e server, one lin
38e0: 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f e} {socket stdio
38f0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
3900: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
3910: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3920: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3930: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
3940: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
3950: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
3960: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
3970: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3980: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3990: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
39a0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
39b0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
39c0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
39d0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 34 $serverKey 8834
39e0: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
39f0: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
3a00: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 {s a p} {.
3a10: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
3a20: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
3a30: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
3a40: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
3a50: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 ranslation lf -b
3a60: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
3a70: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
3a80: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 ho {s} {.. s
3a90: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 et l [gets $s].
3aa0: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b if {
3ab0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 [eof $s]} {.
3ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f glo
3ad0: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
3ae0: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a close $s.
3af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3b00: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
3b10: 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 } else
3b20: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
3b30: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
3b40: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a }..}.
3b50: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
3b60: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
3b70: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
3b80: 20 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 $f..puts done.
3b90: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3ba0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
3bb0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3bc0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3bd0: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
3be0: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 ts $f. set s
3bf0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
3c00: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
3c10: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3c20: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
3c30: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
3c40: 30 2e 31 20 38 38 33 34 5d 0a 20 20 20 20 66 63 0.1 8834]. fc
3c50: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
3c60: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
3c70: 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 nslation lf.
3c80: 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 puts $s "hello a
3c90: 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 bcdefghijklmnop"
3ca0: 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 0a . after 1000.
3cb0: 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 set x [gets
3cc0: 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s]. close $s
3cd0: 0a 20 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 . set y [gets
3ce0: 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $f]. close $
3cf0: 66 0a 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 f. list $x $y
3d00: 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 .} {{hello abcde
3d10: 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e fghijklmnop} don
3d20: 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 e}..test tlsIO-2
3d30: 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c .8 {echo server,
3d40: 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 loop 50 times,
3d50: 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f single connectio
3d60: 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f n} {socket stdio
3d70: 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 20 5b 6f } {. set f [o
3d80: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
3d90: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
3da0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
3db0: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
3dc0: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3dd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3de0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
3df0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
3e00: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3e10: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
3e20: 72 4b 65 79 20 38 38 33 35 20 5c 5d 22 0a 20 20 rKey 8835 \]".
3e30: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
3e40: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
3e50: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 {. f
3e60: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
3e70: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
3e80: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
3e90: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
3ea0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
3eb0: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
3ec0: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 ho {s} {.. g
3ed0: 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 lobal i.
3ee0: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
3ef0: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
3f00: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
3f10: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
3f20: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
3f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
3f40: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
3f50: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
3f60: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
3f70: 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 else { ..
3f80: 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 incr i.
3f90: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
3fa0: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
3fb0: 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 }..}..set i 0
3fc0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
3fd0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
3fe0: 30 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 0000 "set x done
3ff0: 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 "]..vwait x..aft
4000: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
4010: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
4020: 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d "done $i". }
4030: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
4040: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
4050: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
4060: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
4070: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
4080: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
4090: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
40a0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
40b0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
40c0: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
40d0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
40e0: 38 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8835]. fconfi
40f0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
4100: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 ng line. catc
4110: 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 h {..for {set x
4120: 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 0} {$x < 50} {in
4130: 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 cr x} {.. put
4140: 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 s $s "hello abcd
4150: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 efghijklmnop"..
4160: 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 gets $s..}.
4170: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
4180: 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 . catch {set
4190: 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 x [gets $f]}.
41a0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
41b0: 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a t x.} {done 50}.
41c0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 39 20 .test tlsIO-2.9
41d0: 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 {socket conflict
41e0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
41f0: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
4200: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4210: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 20 r accept 8828].
4220: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
4230: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
4240: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
4250: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
4260: 6e 65 20 24 66 20 7b 70 61 63 6b 61 67 65 20 72 ne $f {package r
4270: 65 71 75 69 72 65 20 74 6c 73 3b 20 74 6c 73 3a equire tls; tls:
4280: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4290: 61 63 63 65 70 74 20 38 38 32 38 7d 0a 20 20 20 accept 8828}.
42a0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
42b0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
42c0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
42d0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
42e0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
42f0: 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 20 20 after 100.
4300: 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 set x [list [cat
4310: 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 ch {close $f} ms
4320: 67 5d 20 24 6d 73 67 5d 0a 20 20 20 20 63 6c 6f g] $msg]. clo
4330: 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 78 0a se $s. set x.
4340: 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f } {1 {couldn't o
4350: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 pen socket: addr
4360: 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 ess already in u
4370: 73 65 0a 20 20 20 20 77 68 69 6c 65 20 65 78 65 se. while exe
4380: 63 75 74 69 6e 67 0a 22 3a 3a 73 6f 63 6b 65 74 cuting."::socket
4390: 20 2d 73 65 72 76 65 72 20 7b 74 6c 73 3a 3a 5f -server {tls::_
43a0: 61 63 63 65 70 74 20 7b 2d 73 65 72 76 65 72 20 accept {-server
43b0: 31 7d 20 61 63 63 65 70 74 7d 20 38 38 32 38 22 1} accept} 8828"
43c0: 0a 20 20 20 20 28 22 65 76 61 6c 22 20 62 6f 64 . ("eval" bod
43d0: 79 20 6c 69 6e 65 20 31 29 0a 20 20 20 20 69 6e y line 1). in
43e0: 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 68 69 voked from withi
43f0: 6e 0a 22 65 76 61 6c 20 3a 3a 73 6f 63 6b 65 74 n."eval ::socket
4400: 20 24 73 6f 70 74 73 22 0a 20 20 20 20 28 70 72 $sopts". (pr
4410: 6f 63 65 64 75 72 65 20 22 74 6c 73 3a 3a 73 6f ocedure "tls::so
4420: 63 6b 65 74 22 20 6c 69 6e 65 20 36 32 29 0a 20 cket" line 62).
4430: 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 invoked from
4440: 77 69 74 68 69 6e 0a 22 74 6c 73 3a 3a 73 6f 63 within."tls::soc
4450: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
4460: 70 74 20 38 38 32 38 22 0a 20 20 20 20 28 66 69 pt 8828". (fi
4470: 6c 65 20 22 73 63 72 69 70 74 22 20 6c 69 6e 65 le "script" line
4480: 20 31 29 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 1)}}..test tlsI
4490: 4f 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 20 6f 6e O-2.10 {close on
44a0: 20 61 63 63 65 70 74 2c 20 61 63 63 65 70 74 65 accept, accepte
44b0: 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 73 7d 20 d socket lives}
44c0: 7b 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 {socket knownBug
44d0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 } {. set done
44e0: 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 0. set timer
44f0: 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 73 [after 20000 "s
4500: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
4510: 74 22 5d 0a 20 20 20 20 73 65 74 20 73 73 20 5b t"]. set ss [
4520: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4530: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
4540: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
4550: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4560: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 \..-keyfile $se
4570: 72 76 65 72 4b 65 79 20 38 38 33 30 5d 0a 20 20 rverKey 8830].
4580: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
4590: 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 a p} {..global
45a0: 73 73 0a 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 ss..close $ss..f
45b0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
45c0: 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 able "readit $s"
45d0: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
45e0: 2d 74 72 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a -trans lf. }.
45f0: 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 proc readit
4600: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f {s} {..global do
4610: 6e 65 0a 09 67 65 74 73 20 24 73 0a 09 63 6c 6f ne..gets $s..clo
4620: 73 65 20 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 se $s..set done
4630: 31 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 1. }. set
4640: 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 cs [tls::socket
4650: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
4660: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
4670: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
4680: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e e $clientKey [in
4690: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 fo hostname] 883
46a0: 30 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0]. close $cs
46b0: 0a 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 .. vwait done
46c0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
46d0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 l $timer. set
46e0: 20 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 done.} 1..test
46f0: 74 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 65 74 65 tlsIO-2.11 {dete
4700: 63 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 cting new data}
4710: 7b 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 {socket knownBug
4720: 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 } {. proc acc
4730: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
4740: 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 73 65 74 20 lobal sock..set
4750: 73 6f 63 6b 20 24 73 0a 09 73 65 74 20 66 20 5b sock $s..set f [
4760: 6f 70 65 6e 20 61 77 62 2e 6c 6f 67 20 77 5d 0a open awb.log w].
4770: 09 70 75 74 73 20 24 66 20 5b 63 61 74 63 68 20 .puts $f [catch
4780: 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 {tls::handshake
4790: 24 73 6f 63 6b 7d 20 65 72 72 5d 0a 09 70 75 74 $sock} err]..put
47a0: 73 20 24 66 20 22 65 72 72 3a 20 24 65 72 72 22 s $f "err: $err"
47b0: 0a 09 70 75 74 73 20 24 66 20 22 5b 74 6c 73 3a ..puts $f "[tls:
47c0: 3a 73 74 61 74 75 73 20 24 73 6f 63 6b 5d 22 0a :status $sock]".
47d0: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
47e0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
47f0: 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 :socket -require
4800: 20 30 20 2d 72 65 71 75 65 73 74 20 30 20 2d 73 0 -request 0 -s
4810: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
4820: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
4830: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4840: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4850: 73 65 72 76 65 72 4b 65 79 20 38 34 30 30 5d 0a serverKey 8400].
4860: 20 20 20 20 73 65 74 20 73 6f 63 6b 20 22 22 0a set sock "".
4870: 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a set s2 [tls:
4880: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
4890: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
48a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
48b0: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
48c0: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
48d0: 34 30 30 5d 0a 20 20 20 20 76 77 61 69 74 20 73 400]. vwait s
48e0: 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 ock. puts $s2
48f0: 20 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 one. flush $
4900: 73 32 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 s2. after 500
4910: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4920: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
4930: 30 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0. set result
4940: 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 [gets $sock].
4950: 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 lappend result
4960: 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 [gets $sock].
4970: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
4980: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 ck -blocking 1.
4990: 20 20 20 70 75 74 73 20 24 73 32 20 74 77 6f 0a puts $s2 two.
49a0: 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 flush $s2.
49b0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
49c0: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 ck -blocking 0.
49d0: 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c lappend resul
49e0: 74 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 t [gets $sock].
49f0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
4a00: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a ock -blocking 1.
4a10: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
4a20: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
4a30: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 lose $sock. s
4a40: 65 74 20 72 65 73 75 6c 74 0a 7d 20 7b 6f 6e 65 et result.} {one
4a50: 20 7b 7d 20 74 77 6f 7d 0a 0a 74 65 73 74 20 74 {} two}..test t
4a60: 6c 73 49 4f 2d 32 2e 31 32 20 7b 74 63 70 20 63 lsIO-2.12 {tcp c
4a70: 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 onnection; no ce
4a80: 72 74 69 66 69 63 61 74 65 73 20 73 70 65 63 69 rtificates speci
4a90: 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 fied} {socket st
4aa0: 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 dio pcCrash} {.
4ab0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
4ac0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
4ad0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
4ae0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
4af0: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
4b00: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
4b10: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
4b20: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
4b30: 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 .set f [tls::soc
4b40: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
4b50: 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 pt 8828]..proc a
4b60: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
4b70: 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c port} {.. gl
4b80: 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 obal x.. set
4b90: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
4ba0: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
4bb0: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
4bc0: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
4bd0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
4be0: 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 se $f..puts $x.
4bf0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
4c00: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
4c10: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
4c20: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
4c30: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
4c40: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
4c50: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
4c60: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 ket 127.0.0.1 88
4c70: 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 28} msg]} {.
4c80: 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 set x $msg.
4c90: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
4ca0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
4cb0: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
4cc0: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
4cd0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b . lappend x [
4ce0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
4cf0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
4d00: 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d } {ready done {}
4d10: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e }..test tlsIO-3.
4d20: 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 1 {socket confli
4d30: 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ct} {socket stdi
4d40: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
4d50: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
4d60: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
4d70: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
4d80: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
4d90: 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 require tls.
4da0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
4db0: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
4dc0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4dd0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
4de0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
4df0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
4e00: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 $serverKey 8828
4e10: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
4e20: 20 7b 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 {..puts ready..
4e30: 67 65 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 gets stdin..clos
4e40: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
4e50: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4e60: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
4e70: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
4e80: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
4e90: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
4ea0: 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 set x [list [ca
4eb0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
4ec0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
4ed0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
4ee0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
4ef0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
4f00: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
4f10: 20 61 63 63 65 70 74 20 38 38 32 38 7d 20 6d 73 accept 8828} ms
4f20: 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 g] \...$msg].
4f30: 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 puts $f bye.
4f40: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4f50: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
4f60: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
4f70: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
4f80: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 in use}}..test t
4f90: 6c 73 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 lsIO-3.2 {server
4fa0: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
4fb0: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
4fc0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
4fd0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
4fe0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
4ff0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
5000: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
5010: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
5020: 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 set t1 [after 30
5030: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
5040: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 32 20 5b _out"]..set t2 [
5050: 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 after 31000 "set
5060: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 x timed_out"]..
5070: 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 set t3 [after 32
5080: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
5090: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 63 6f 75 6e _out"]..set coun
50a0: 74 65 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 ter 0. }.
50b0: 70 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c puts $f "set s \
50c0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
50d0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
50e0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
50f0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5100: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
5110: 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 erKey 8828 \]".
5120: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
5130: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
5140: 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 } {.. fileeve
5150: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
5160: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 list echo $s]..
5170: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5180: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5190: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
51a0: 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 s} {.. globa
51b0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
51c0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
51d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 . if
51e0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
51f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
5200: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
5210: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
5220: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
5230: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
5240: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
5250: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
5260: 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 }..}..puts re
5270: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
5280: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 09 ter cancel $t1..
5290: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
52a0: 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 61 69 74 ancel $t2..vwait
52b0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
52c0: 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 73 0a 09 $t3..close $s..
52d0: 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 puts $x. }.
52e0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
52f0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
5300: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
5310: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
5320: 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 5b 67 r+]. set x [g
5330: 65 74 73 20 24 66 5d 0a 20 20 20 20 73 65 74 20 ets $f]. set
5340: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
5350: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
5360: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
5370: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5380: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
5390: 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e \.. 127.0.0.
53a0: 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 8828]. fcon
53b0: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 figure $s1 -buff
53c0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
53d0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
53e0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
53f0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
5400: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
5410: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
5420: 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 Key \.. 127.0
5430: 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 .0.1 8828]. f
5440: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 configure $s2 -b
5450: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
5460: 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 set s3 [tls::s
5470: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
5480: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
5490: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
54a0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
54b0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
54c0: 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 7.0.0.1 8828].
54d0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 fconfigure $s3
54e0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
54f0: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
5500: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
5510: 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 ncr i} {..puts $
5520: 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 s1 hello,s1..get
5530: 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 s $s1..puts $s2
5540: 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 hello,s2..gets $
5550: 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c s2..puts $s3 hel
5560: 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a lo,s3..gets $s3.
5570: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
5580: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
5590: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
55a0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
55b0: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
55c0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
55d0: 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 {ready done}..t
55e0: 65 73 74 20 74 6c 73 49 4f 2d 34 2e 31 20 7b 73 est tlsIO-4.1 {s
55f0: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
5600: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 68 61 6e al clients} {han
5610: 67 73 48 6f 62 62 73 20 73 6f 63 6b 65 74 20 73 gsHobbs socket s
5620: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
5630: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
5640: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
5650: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
5660: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
5670: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
5680: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
5690: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
56a0: 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s \[tls::socke
56b0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
56c0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
56d0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
56e0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
56f0: 30 2e 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 0.0.1 8828 \]".
5700: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 puts $f {..fc
5710: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
5720: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 fering line..for
5730: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
5740: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
5750: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 .. puts $s he
5760: 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 llo.. gets $s
5770: 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 ..}..close $s..p
5780: 75 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 uts bye..gets st
5790: 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c din. }. cl
57a0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 ose $f. set p
57b0: 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 1 [open "|[list
57c0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
57d0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
57e0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
57f0: 24 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $p1 -buffering l
5800: 69 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b ine. set p2 [
5810: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
5820: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
5830: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
5840: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 fconfigure $p2
5850: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5860: 0a 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 . set p3 [ope
5870: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
5880: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
5890: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 ript]" r+]. f
58a0: 63 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 configure $p3 -b
58b0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
58c0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
58d0: 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 a p} {..fconfig
58e0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
58f0: 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e g line..fileeven
5900: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
5910: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
5920: 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f }. proc echo
5930: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 {s} {..global x
5940: 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b . set l [
5950: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 gets $s].
5960: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
5970: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
5980: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
5990: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
59a0: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 } else {.
59b0: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
59c0: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 s $l. }.
59d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 }. set t1
59e0: 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 [after 30000 "se
59f0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
5a00: 20 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 set t2 [afte
5a10: 72 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 r 31000 "set x t
5a20: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
5a30: 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 et t3 [after 320
5a40: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5a50: 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 out"]. set s
5a60: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
5a70: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
5a80: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
5a90: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
5aa0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
5ab0: 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 .-server acc
5ac0: 65 70 74 20 38 38 32 38 5d 0a 20 20 20 20 70 75 ept 8828]. pu
5ad0: 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 ts $p1 open.
5ae0: 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 puts $p2 open.
5af0: 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e 0a puts $p3 open.
5b00: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
5b10: 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 vwait x. vwai
5b20: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
5b30: 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 74 ncel $t1. aft
5b40: 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 er cancel $t2.
5b50: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
5b60: 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a t3. close $s.
5b70: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
5b80: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 lappend l [list
5b90: 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 24 p1 [gets $p1] $
5ba0: 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c x]. lappend l
5bb0: 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 20 [list p2 [gets
5bc0: 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 $p2] $x]. lap
5bd0: 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 pend l [list p3
5be0: 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 [gets $p3] $x].
5bf0: 20 20 20 70 75 74 73 20 24 70 31 20 62 79 65 0a puts $p1 bye.
5c00: 20 20 20 20 70 75 74 73 20 24 70 32 20 62 79 65 puts $p2 bye
5c10: 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 62 79 . puts $p3 by
5c20: 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 0a e. close $p1.
5c30: 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 close $p2.
5c40: 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 close $p3.
5c50: 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 set l.} {{p1 bye
5c60: 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 done} {p2 bye d
5c70: 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e one} {p3 bye don
5c80: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
5c90: 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 4.2 {byte order
5ca0: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
5cb0: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
5cc0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
5cd0: 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 set x ok. if
5ce0: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
5cf0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
5d00: 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 o 0x3000} msg]}
5d10: 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 {..set x $msg.
5d20: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 } else {..clos
5d30: 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 e $msg. }.
5d40: 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 set x.} ok..tes
5d50: 74 20 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 74 t tlsIO-5.1 {byt
5d60: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
5d70: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
5d80: 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 , htons} \..{soc
5d90: 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 ket unixOnly not
5da0: 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 Root} {. set
5db0: 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e x {couldn't open
5dc0: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
5dd0: 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 er}. if {![ca
5de0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
5df0: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 -server dodo 0x
5e00: 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 1} msg]} {.
5e10: 20 20 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 set x {htons
5e20: 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 problem, should
5e30: 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 be disallowed, a
5e40: 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 re you running a
5e50: 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d s SU?}..close $m
5e60: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
5e70: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
5e80: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
5e90: 6f 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 owner}.test tlsI
5ea0: 4f 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 O-5.2 {byte orde
5eb0: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
5ec0: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
5ed0: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
5ee0: 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 set x {couldn'
5ef0: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
5f00: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
5f10: 69 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 igh}. if {![c
5f20: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
5f30: 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 t -server dodo 0
5f40: 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a x10000} msg]} {.
5f50: 09 73 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 .set x {port res
5f60: 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c olution problem,
5f70: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
5f80: 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d lowed}..close $m
5f90: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
5fa0: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
5fb0: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 pen socket: port
5fc0: 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 number too high
5fd0: 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 33 }.test tlsIO-5.3
5fe0: 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f {byte order pro
5ff0: 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 blems, socket nu
6000: 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a mbers, htons} \.
6010: 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c .{socket unixOnl
6020: 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 y notRoot} {.
6030: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 set x {couldn't
6040: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
6050: 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 t owner}. if
6060: 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {![catch {tls::s
6070: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
6080: 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 do 21} msg]} {..
6090: 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f set x {htons pro
60a0: 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 blem, should be
60b0: 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 disallowed, are
60c0: 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 you running as S
60d0: 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a U?}..close $msg.
60e0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a }. set x.
60f0: 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e } {couldn't open
6100: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
6110: 65 72 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d er}..test tlsIO-
6120: 36 2e 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 6.1 {accept call
6130: 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 75 6e 65 back error} {une
6140: 78 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 xplainedFailure
6150: 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 socket stdio pcC
6160: 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rash} {. remo
6170: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
6180: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
6190: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
61a0: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
61b0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
61c0: 67 65 74 73 20 73 74 64 69 6e 0a 09 74 6c 73 3a gets stdin..tls:
61d0: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
61e0: 31 20 38 38 34 38 0a 20 20 20 20 7d 0a 20 20 20 1 8848. }.
61f0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6200: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
6210: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
6220: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
6230: 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 +]. proc bger
6240: 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 ror args {..glob
6250: 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 al x..set x $arg
6260: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 s. }. proc
6270: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
6280: 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 {expr 10 / 0}.
6290: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
62a0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
62b0: 65 70 74 20 38 38 34 38 5d 0a 20 20 20 20 70 75 ept 8848]. pu
62c0: 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 ts $f hello.
62d0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
62e0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
62f0: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
6300: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
6310: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
6320: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
6330: 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 lose $s. rena
6340: 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 me bgerror {}.
6350: 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 set x.} {{divi
6360: 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 23 20 de by zero}}..#
6370: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
6380: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
6390: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
63a0: 20 66 6f 72 20 27 2d 70 65 65 72 6e 61 6d 65 27 for '-peername'
63b0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 31 ..test tlsIO-7.1
63c0: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
63d0: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
63e0: 73 7d 20 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 s} {knownBug soc
63f0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
6400: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
6410: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
6420: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
6430: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
6440: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
6450: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
6460: 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f "tls::socket -
6470: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
6480: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
6490: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
64a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
64b0: 72 76 65 72 4b 65 79 20 38 38 32 30 22 0a 20 20 rverKey 8820".
64c0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
64d0: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
64e0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
64f0: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
6500: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
6510: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
6520: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
6530: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
6540: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
6550: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
6560: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6570: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
6580: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
6590: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
65a0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
65b0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
65c0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
65d0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
65e0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
65f0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
6600: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
6610: 30 2e 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 20 0.0.1 8820].
6620: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
6630: 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a e $s -peername].
6640: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
6650: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
6660: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
6670: 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d nd l [string com
6680: 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 pare [lindex $p
6690: 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 0] 127.0.0.1].
66a0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 lappend l [str
66b0: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e ing compare [lin
66c0: 64 65 78 20 24 70 20 32 5d 20 38 38 32 30 5d 0a dex $p 2] 8820].
66d0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
66e0: 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 20 length $p].} {0
66f0: 30 20 33 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f 0 3}..# bug repo
6700: 72 74 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 rt #5812 fconfig
6710: 75 72 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 ure doesn't retu
6720: 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 rn value for '-s
6730: 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 ockname'..test t
6740: 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 73 74 69 6e lsIO-7.2 {testin
6750: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
6760: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 c options} {know
6770: 6e 42 75 67 20 73 6f 63 6b 65 74 20 73 74 64 69 nBug socket stdi
6780: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
6790: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
67a0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
67b0: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
67c0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
67d0: 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 ire tls. }.
67e0: 20 20 70 75 74 73 20 24 66 20 22 74 6c 73 3a 3a puts $f "tls::
67f0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6800: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
6810: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
6820: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
6830: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
6840: 38 38 32 31 22 0a 20 20 20 20 70 75 74 73 20 24 8821". puts $
6850: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
6860: 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f args {.. glo
6870: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
6880: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
6890: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
68a0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
68b0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
68c0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
68d0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
68e0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
68f0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
6900: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
6910: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
6920: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
6930: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
6940: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
6950: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
6960: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
6970: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6980: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
6990: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
69a0: 32 31 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 21]. set p [f
69b0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
69c0: 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ckname]. clos
69d0: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
69e0: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
69f0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c lappend l [ll
6a00: 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 ength $p]. la
6a10: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
6a20: 24 70 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e $p 0]. lappen
6a30: 64 20 6c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 d l [string equa
6a40: 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 l [lindex $p 2]
6a50: 38 38 32 31 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 8821].} {3 127.0
6a60: 2e 30 2e 31 20 30 7d 0a 0a 74 65 73 74 20 74 6c .0.1 0}..test tl
6a70: 73 49 4f 2d 37 2e 33 20 7b 74 65 73 74 69 6e 67 sIO-7.3 {testing
6a80: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
6a90: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
6aa0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b t} {. set s [
6ab0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
6ac0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
6ad0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6ae0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6af0: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
6b00: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
6b10: 38 32 32 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 822]. set l [
6b20: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 5d 0a 20 fconfigure $s].
6b30: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
6b40: 75 70 64 61 74 65 0a 20 20 20 20 6c 6c 65 6e 67 update. lleng
6b50: 74 68 20 24 6c 0a 7d 20 31 32 0a 0a 23 20 62 75 th $l.} 12..# bu
6b60: 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 g report #5812 f
6b70: 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 configure doesn'
6b80: 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 t return value f
6b90: 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a or '-sockname'..
6ba0: 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 34 20 7b test tlsIO-7.4 {
6bb0: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
6bc0: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
6bd0: 20 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 {knownBug socke
6be0: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b t} {. set s [
6bf0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
6c00: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
6c10: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
6c20: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6c30: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
6c40: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
6c50: 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 823]. proc ac
6c60: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
6c70: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
6c80: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
6c90: 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 sockname]..close
6ca0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
6cb0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
6cc0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
6cd0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
6ce0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6cf0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
6d00: 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 . .[info host
6d10: 6e 61 6d 65 5d 20 38 38 32 33 5d 0a 20 20 20 20 name] 8823].
6d20: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6d30: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6d40: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6d50: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6d60: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6d70: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
6d80: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
6d90: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
6da0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 d l [lindex $x 2
6db0: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d ] [llength $x].}
6dc0: 20 7b 38 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 {8823 3}..# bug
6dd0: 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 report #5812 fc
6de0: 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 onfigure doesn't
6df0: 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f return value fo
6e00: 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 r '-sockname'..t
6e10: 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 est tlsIO-7.5 {t
6e20: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
6e30: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
6e40: 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 {knownBug socket
6e50: 20 75 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 20 unixOrPc} {.
6e60: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6e70: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
6e80: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
6e90: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
6ea0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
6eb0: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
6ec0: 61 63 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 accept 8829].
6ed0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
6ee0: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 a p} {..global x
6ef0: 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 ..set x [fconfig
6f00: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 ure $s -sockname
6f10: 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 ]..close $s.
6f20: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
6f30: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
6f40: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
6f50: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6f60: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
6f70: 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 31 32 entKey \. .12
6f80: 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 0a 20 20 7.0.0.1 8829].
6f90: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
6fa0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
6fb0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
6fc0: 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 vwait x. afte
6fd0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
6fe0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
6ff0: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 close $s1. s
7000: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
7010: 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 end l [lindex $x
7020: 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 0] [lindex $x 2
7030: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d ] [llength $x].}
7040: 20 7b 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 {127.0.0.1 8829
7050: 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 3}..test tlsIO-
7060: 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 8.1 {testing -as
7070: 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b ync flag on sock
7080: 65 74 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 ets} {unexplaine
7090: 64 48 61 6e 67 20 73 6f 63 6b 65 74 7d 20 7b 0a dHang socket} {.
70a0: 20 20 20 20 23 20 74 65 73 74 20 73 65 65 6d 73 # test seems
70b0: 20 74 6f 20 68 61 6e 67 20 2d 2d 20 61 77 62 20 to hang -- awb
70c0: 36 2f 32 2f 32 30 30 30 0a 20 20 20 20 23 20 4e 6/2/2000. # N
70d0: 4f 54 45 3a 20 54 68 69 73 20 74 65 73 74 20 6d OTE: This test m
70e0: 61 79 20 66 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 ay fail on some
70f0: 53 6f 6c 61 72 69 73 20 32 2e 34 20 73 79 73 74 Solaris 2.4 syst
7100: 65 6d 73 2e 20 49 66 20 69 74 20 64 6f 65 73 2c ems. If it does,
7110: 0a 20 20 20 20 23 20 63 68 65 63 6b 20 74 68 61 . # check tha
7120: 74 20 79 6f 75 20 68 61 76 65 20 74 68 65 73 65 t you have these
7130: 20 70 61 74 63 68 65 73 20 69 6e 73 74 61 6c 6c patches install
7140: 65 64 20 28 75 73 69 6e 67 20 73 68 6f 77 72 65 ed (using showre
7150: 76 20 2d 70 29 3a 0a 20 20 20 20 23 0a 20 20 20 v -p):. #.
7160: 20 23 20 31 30 31 39 30 37 2d 30 35 2c 20 31 30 # 101907-05, 10
7170: 31 39 32 35 2d 30 32 2c 20 31 30 31 39 34 35 2d 1925-02, 101945-
7180: 31 34 2c 20 31 30 31 39 35 39 2d 30 33 2c 20 31 14, 101959-03, 1
7190: 30 31 39 36 39 2d 30 35 2c 20 31 30 31 39 37 33 01969-05, 101973
71a0: 2d 30 33 2c 0a 20 20 20 20 23 20 31 30 31 39 37 -03,. # 10197
71b0: 37 2d 30 33 2c 20 31 30 31 39 38 31 2d 30 32 2c 7-03, 101981-02,
71c0: 20 31 30 31 39 38 35 2d 30 31 2c 20 31 30 32 30 101985-01, 1020
71d0: 30 31 2d 30 33 2c 20 31 30 32 30 30 33 2d 30 31 01-03, 102003-01
71e0: 2c 20 31 30 32 30 30 37 2d 30 31 2c 0a 20 20 20 , 102007-01,.
71f0: 20 23 20 31 30 32 30 31 31 2d 30 32 2c 20 31 30 # 102011-02, 10
7200: 32 30 32 34 2d 30 31 2c 20 31 30 32 30 33 39 2d 2024-01, 102039-
7210: 30 31 2c 20 31 30 32 30 34 34 2d 30 31 2c 20 31 01, 102044-01, 1
7220: 30 32 30 34 38 2d 30 31 2c 20 31 30 32 30 36 32 02048-01, 102062
7230: 2d 30 33 2c 0a 20 20 20 20 23 20 31 30 32 30 36 -03,. # 10206
7240: 36 2d 30 34 2c 20 31 30 32 30 37 30 2d 30 31 2c 6-04, 102070-01,
7250: 20 31 30 32 31 30 35 2d 30 31 2c 20 31 30 32 31 102105-01, 1021
7260: 35 33 2d 30 33 2c 20 31 30 32 32 31 36 2d 30 31 53-03, 102216-01
7270: 2c 20 31 30 32 32 33 32 2d 30 31 2c 0a 20 20 20 , 102232-01,.
7280: 20 23 20 31 30 31 38 37 38 2d 30 33 2c 20 31 30 # 101878-03, 10
7290: 31 38 37 39 2d 30 31 2c 20 31 30 31 38 38 30 2d 1879-01, 101880-
72a0: 30 33 2c 20 31 30 31 39 33 33 2d 30 31 2c 20 31 03, 101933-01, 1
72b0: 30 31 39 35 30 2d 30 31 2c 20 31 30 32 30 33 30 01950-01, 102030
72c0: 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 32 30 35 -01,. # 10205
72d0: 37 2d 30 38 2c 20 31 30 32 31 34 30 2d 30 31 2c 7-08, 102140-01,
72e0: 20 31 30 31 39 32 30 2d 30 32 2c 20 31 30 31 39 101920-02, 1019
72f0: 32 31 2d 30 39 2c 20 31 30 31 39 32 32 2d 30 37 21-09, 101922-07
7300: 2c 20 31 30 31 39 32 33 2d 30 33 0a 20 20 20 20 , 101923-03.
7310: 23 0a 20 20 20 20 23 20 49 66 20 61 66 74 65 72 #. # If after
7320: 20 69 6e 73 74 61 6c 6c 69 6e 67 20 74 68 65 73 installing thes
7330: 65 20 70 61 74 63 68 65 73 20 79 6f 75 20 61 72 e patches you ar
7340: 65 20 73 74 69 6c 6c 20 65 78 70 65 72 69 65 6e e still experien
7350: 63 69 6e 67 20 61 0a 20 20 20 20 23 20 70 72 6f cing a. # pro
7360: 62 6c 65 6d 2c 20 70 6c 65 61 73 65 20 65 6d 61 blem, please ema
7370: 69 6c 20 6a 79 6c 40 65 6e 67 2e 73 75 6e 2e 63 il jyl@eng.sun.c
7380: 6f 6d 2e 20 57 65 20 68 61 76 65 20 6e 6f 74 20 om. We have not
7390: 6f 62 73 65 72 76 65 64 20 74 68 69 73 0a 20 20 observed this.
73a0: 20 20 23 20 66 61 69 6c 75 72 65 20 6f 6e 20 53 # failure on S
73b0: 6f 6c 61 72 69 73 20 32 2e 35 2c 20 73 6f 20 61 olaris 2.5, so a
73c0: 6e 6f 74 68 65 72 20 6f 70 74 69 6f 6e 20 28 69 nother option (i
73d0: 6e 73 74 65 61 64 20 6f 66 20 69 6e 73 74 61 6c nstead of instal
73e0: 6c 69 6e 67 0a 20 20 20 20 23 20 74 68 65 73 65 ling. # these
73f0: 20 70 61 74 63 68 65 73 29 20 69 73 20 74 6f 20 patches) is to
7400: 75 70 67 72 61 64 65 20 74 6f 20 53 6f 6c 61 72 upgrade to Solar
7410: 69 73 20 32 2e 35 2e 0a 20 20 20 20 73 65 74 20 is 2.5.. set
7420: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
7430: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
7440: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
7450: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
7460: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 $serverKey \.
7470: 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 .-server accep
7480: 74 20 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 t 8830]. proc
7490: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
74a0: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 70 75 74 {..global x..put
74b0: 73 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 s $s bye..close
74c0: 24 73 0a 09 73 65 74 20 78 20 64 6f 6e 65 0a 20 $s..set x done.
74d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
74e0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
74f0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
7500: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
7510: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
7520: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 2d 61 73 clientKey \..-as
7530: 79 6e 63 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 ync [info hostna
7540: 6d 65 5d 20 38 38 33 30 5d 0a 20 20 20 20 76 77 me] 8830]. vw
7550: 61 69 74 20 78 0a 20 20 20 20 73 65 74 20 7a 20 ait x. set z
7560: 5b 67 65 74 73 20 24 73 31 5d 0a 20 20 20 20 63 [gets $s1]. c
7570: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
7580: 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 7a 0a e $s1. set z.
7590: 7d 20 62 79 65 0a 0a 74 65 73 74 20 74 6c 73 49 } bye..test tlsI
75a0: 4f 2d 39 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 O-9.1 {testing s
75b0: 70 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 purious events}
75c0: 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 {unexplainedHang
75d0: 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 socket} {. #
75e0: 20 6c 6f 63 6b 73 20 75 70 20 0a 20 20 20 20 73 locks up . s
75f0: 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 et len 0. set
7600: 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 spurious 0.
7610: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 set done 0. p
7620: 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b roc readlittle {
7630: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 s} {..global spu
7640: 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 rious done len..
7650: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 set l [read $s 1
7660: 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c ]..if {[string l
7670: 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 ength $l] == 0}
7680: 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 {.. if {![eof
7690: 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 $s]} {...incr s
76a0: 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 purious.. } e
76b0: 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 lse {...close $s
76c0: 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 ...set done 1..
76d0: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 }..} else {..
76e0: 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 incr len [st
76f0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
7700: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f .}. }. pro
7710: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
7720: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
7730: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e s -buffering non
7740: 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 0a e -blocking off.
7750: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
7760: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 adable [list rea
7770: 64 6c 69 74 74 6c 65 20 24 73 5d 0a 20 20 20 20 dlittle $s].
7780: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
7790: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
77a0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
77b0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
77c0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
77d0: 65 72 4b 65 79 20 5c 0a 20 20 20 09 2d 73 65 72 erKey \. .-ser
77e0: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 31 5d ver accept 8831]
77f0: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
7800: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
7810: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
7820: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7830: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
7840: 74 4b 65 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 tKey \. .[inf
7850: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 31 o hostname] 8831
7860: 5d 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 ]. puts -none
7870: 77 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 wline $c 0123456
7880: 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 7890123456789012
7890: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
78a0: 39 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 90123456789.
78b0: 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 close $c. set
78c0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
78d0: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
78e0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
78f0: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
7900: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
7910: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
7920: 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 list $spurious
7930: 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a $len.} {0 50}..
7940: 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b test tlsIO-9.2 {
7950: 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 testing async wr
7960: 69 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c ite, fileevents,
7970: 20 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d flush on close}
7980: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
7990: 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 set firstblock "
79a0: 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 ". for {set i
79b0: 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 0} {$i < 5} {in
79c0: 63 72 20 69 7d 20 7b 73 65 74 20 66 69 72 73 74 cr i} {set first
79d0: 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 62 6c block "a$firstbl
79e0: 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 7d ock$firstblock"}
79f0: 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 . set secondb
7a00: 6c 6f 63 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 lock "". for
7a10: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
7a20: 31 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 16} {incr i} {..
7a30: 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 set secondblock
7a40: 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 "b$secondblock$s
7a50: 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 20 20 20 20 econdblock".
7a60: 7d 0a 20 20 20 20 73 65 74 20 6c 20 5b 74 6c 73 }. set l [tls
7a70: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
7a80: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
7a90: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7aa0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
7ab0: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
7ac0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 32 rver accept 8832
7ad0: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
7ae0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f t {s a p} {..fco
7af0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
7b00: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 king 0 -translat
7b10: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 ion lf -buffersi
7b20: 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 ze 16384 \...-bu
7b30: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 ffering line..fi
7b40: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
7b50: 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 ble "readable $s
7b60: 22 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 ". }. proc
7b70: 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a readable {s} {.
7b80: 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d .set l [gets $s]
7b90: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
7ba0: 65 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 eadable {}..afte
7bb0: 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 r 1000 respond $
7bc0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 s. }. proc
7bd0: 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 respond {s} {..
7be0: 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 global firstbloc
7bf0: 6b 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 k..puts -nonewli
7c00: 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 ne $s $firstbloc
7c10: 6b 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 72 k..after 1000 wr
7c20: 69 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d itedata $s. }
7c30: 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 . proc writed
7c40: 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 ata {s} {..globa
7c50: 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 70 l secondblock..p
7c60: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
7c70: 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 s $secondblock..
7c80: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 close $s. }.
7c90: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
7ca0: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
7cb0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
7cc0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7cd0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
7ce0: 65 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 ey \. .[info
7cf0: 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 32 5d 0a hostname] 8832].
7d00: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
7d10: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 s -blocking 0 -t
7d20: 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 rans lf -bufferi
7d30: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
7d40: 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 count 0. puts
7d50: 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 70 72 $s hello. pr
7d60: 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a oc readit {s} {.
7d70: 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f .global count do
7d80: 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 ne..set l [read
7d90: 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 $s]..incr count
7da0: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
7db0: 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d l]..if {[eof $s]
7dc0: 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 } {.. close $
7dd0: 73 0a 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 s.. set done
7de0: 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 66 1..}. }. f
7df0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
7e00: 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 able "readit $s"
7e10: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
7e20: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
7e30: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
7e40: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
7e50: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
7e60: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
7e70: 73 65 20 24 6c 0a 20 20 20 20 73 65 74 20 63 6f se $l. set co
7e80: 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 unt.} 65566..tes
7e90: 74 20 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 65 73 t tlsIO-9.3 {tes
7ea0: 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e ting EOF stickyn
7eb0: 65 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 ess} {unexplaine
7ec0: 64 48 61 6e 67 20 73 6f 63 6b 65 74 7d 20 7b 0a dHang socket} {.
7ed0: 20 20 20 20 23 20 68 61 6e 67 73 0a 20 20 20 20 # hangs.
7ee0: 70 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f proc count_to_eo
7ef0: 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 f {s} {..global
7f00: 63 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 count done timer
7f10: 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 ..set l [gets $s
7f20: 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d ]..if {[eof $s]}
7f30: 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 {.. incr cou
7f40: 6e 74 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 nt.. if {$cou
7f50: 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 nt > 9} {...clos
7f60: 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 e $s...set done
7f70: 74 72 75 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 true...set count
7f80: 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d {eof is sticky}
7f90: 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 ...after cancel
7fa0: 24 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d $timer.. }..}
7fb0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
7fc0: 74 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 timerproc {} {..
7fd0: 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e global done coun
7fe0: 74 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 t c..set done tr
7ff0: 75 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 ue..set count {t
8000: 69 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 imer went off, e
8010: 6f 66 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 of is not sticky
8020: 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 }..close $c.
8030: 7d 09 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 }.. set count
8040: 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 0. set done
8050: 66 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 false. proc w
8060: 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 rite_then_close
8070: 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 {s} {..puts $s b
8080: 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 ye..close $s.
8090: 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 }. proc acce
80a0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
80b0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
80c0: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
80d0: 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c nslation lf..fil
80e0: 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 eevent $s writab
80f0: 6c 65 20 22 77 72 69 74 65 5f 74 68 65 6e 5f 63 le "write_then_c
8100: 6c 6f 73 65 20 24 73 22 0a 20 20 20 20 7d 0a 20 lose $s". }.
8110: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8120: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
8130: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
8140: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8150: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8160: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
8170: 72 20 61 63 63 65 70 74 20 38 38 33 33 5d 0a 20 r accept 8833].
8180: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
8190: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
81a0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
81b0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
81c0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
81d0: 65 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 ey \. .[info
81e0: 68 6f 73 74 6e 61 6d 65 5d 20 38 38 33 33 5d 0a hostname] 8833].
81f0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
8200: 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 20 c -blocking off
8210: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
8220: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a -translation lf.
8230: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
8240: 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 readable "count
8250: 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 _to_eof $c".
8260: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
8270: 20 31 30 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 1000 timerproc]
8280: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
8290: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
82a0: 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f set count.} {eo
82b0: 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 f is sticky}..re
82c0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
82d0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 30 2e 31 .test tlsIO-10.1
82e0: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
82f0: 20 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b accept callback
8300: 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d error handling}
8310: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
8320: 73 65 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 set goterror 0.
8330: 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 proc bgerror
8340: 61 72 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 args {global got
8350: 65 72 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 error; set goter
8360: 72 6f 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 ror 1}. set s
8370: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8380: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
8390: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
83a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
83b0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 $serverKey \.
83c0: 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 .-server accept
83d0: 20 38 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 8898]. proc
83e0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
83f0: 63 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 7d close $s; error}
8400: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
8410: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
8420: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
8430: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8440: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
8450: 74 4b 65 79 20 5c 0a 09 31 32 37 2e 30 2e 30 2e tKey \..127.0.0.
8460: 31 20 38 38 39 38 5d 0a 20 20 20 20 76 77 61 69 1 8898]. vwai
8470: 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 t goterror. c
8480: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
8490: 65 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 e $c. set got
84a0: 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 error.} 1..test
84b0: 74 6c 73 49 4f 2d 31 31 2e 31 20 7b 74 63 70 20 tlsIO-11.1 {tcp
84c0: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
84d0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
84e0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
84f0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8500: 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 set caCert $caCe
8510: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8520: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 and "set serverC
8530: 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 ert $serverCert"
8540: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8550: 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 "set clientCert
8560: 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 $clientCert".
8570: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8580: 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 et serverKey $se
8590: 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e rverKey". sen
85a0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
85b0: 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b ientKey $clientK
85c0: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
85d0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
85e0: 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_1_test_server
85f0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
8600: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
8610: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
8620: 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 erCert \...-cafi
8630: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d le $caCert \...-
8640: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
8650: 65 79 20 5c 0a 09 09 38 38 33 34 5d 0a 09 70 72 ey \...8834]..pr
8660: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
8670: 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 } {.. puts $s
8680: 20 64 6f 6e 65 0a 09 20 20 20 20 74 6c 73 3a 3a done.. tls::
8690: 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 handshake $s..
86a0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
86b0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
86c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
86d0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
86e0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
86f0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8700: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8710: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
8720: 49 50 20 38 38 33 34 5d 0a 20 20 20 20 73 65 74 IP 8834]. set
8730: 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 r [gets $s].
8740: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
8750: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
8760: 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 $socket9_1_test
8770: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
8780: 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 74 20 r.} done..test
8790: 74 6c 73 49 4f 2d 31 31 2e 32 20 7b 63 6c 69 65 tlsIO-11.2 {clie
87a0: 6e 74 20 73 70 65 63 69 66 69 65 73 20 69 74 73 nt specifies its
87b0: 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 64 port} {socket d
87c0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
87d0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
87e0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
87f0: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
8800: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8810: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
8820: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
8830: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8840: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
8850: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
8860: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
8870: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
8880: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
8890: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
88a0: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
88b0: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
88c0: 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e sts port]} {..in
88d0: 63 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 6c cr port. } el
88e0: 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 5b se {..set port [
88f0: 65 78 70 72 20 24 74 6c 73 53 65 72 76 65 72 50 expr $tlsServerP
8900: 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 ort + [pid]%1024
8910: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 ]. }. send
8920: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
8930: 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 ocket9_2_test_se
8940: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
8950: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
8960: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
8970: 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d serverCert \...-
8980: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
8990: 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 ...-keyfile $ser
89a0: 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 38 38 verKey \.. 88
89b0: 33 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 35]..proc accept
89c0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
89d0: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
89e0: 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 24 s.. puts $s $
89f0: 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a p.. close $s.
8a00: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
8a10: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
8a20: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
8a30: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
8a40: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8a50: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
8a60: 20 5c 0a 09 20 20 20 20 2d 6d 79 70 6f 72 74 20 \.. -myport
8a70: 24 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 $port $remoteSer
8a80: 76 65 72 49 50 20 38 38 33 35 5d 0a 20 20 20 20 verIP 8835].
8a90: 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a set r [gets $s].
8aa0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
8ab0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
8ac0: 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 ose $socket9_2_t
8ad0: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
8ae0: 69 66 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d if {$r == $port}
8af0: 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 6f {..set result o
8b00: 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 k. } else {..
8b10: 73 65 74 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 set result broke
8b20: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 n. }. set
8b30: 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a 74 65 73 74 result.} ok.test
8b40: 20 74 6c 73 49 4f 2d 31 31 2e 33 20 7b 74 72 79 tlsIO-11.3 {try
8b50: 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 ing to connect,
8b60: 6e 6f 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b no server} {sock
8b70: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
8b80: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
8b90: 20 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a set status ok.
8ba0: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
8bb0: 7b 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 {set s [tls::soc
8bc0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
8bd0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
8be0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8bf0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
8c00: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
8c10: 6f 74 65 53 65 72 76 65 72 49 70 20 38 38 33 36 oteServerIp 8836
8c20: 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 ]}]} {..if {![ca
8c30: 74 63 68 20 7b 67 65 74 73 20 24 73 7d 5d 7d 20 tch {gets $s}]}
8c40: 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 75 {.. set statu
8c50: 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f s broken..}..clo
8c60: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
8c70: 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a set status.} ok.
8c80: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 34 .test tlsIO-11.4
8c90: 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 6f {remote echo, o
8ca0: 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 ne line} {socket
8cb0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
8cc0: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
8cd0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8ce0: 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 caCert $caCert"
8cf0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8d00: 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 "set serverCert
8d10: 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 $serverCert".
8d20: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
8d30: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 et clientCert $c
8d40: 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 lientCert". s
8d50: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
8d60: 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 serverKey $serve
8d70: 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f rKey". sendCo
8d80: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
8d90: 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 tKey $clientKey"
8da0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8db0: 20 7b 0a 20 20 20 20 09 67 6c 6f 62 61 6c 20 73 {. .global s
8dc0: 65 72 76 65 72 43 65 72 74 0a 09 67 6c 6f 62 61 erverCert..globa
8dd0: 6c 20 63 61 43 65 72 74 0a 09 67 6c 6f 62 61 6c l caCert..global
8de0: 20 73 65 72 76 65 72 4b 65 79 0a 09 73 65 74 20 serverKey..set
8df0: 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f socket10_6_test_
8e00: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
8e10: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
8e20: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
8e30: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
8e40: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
8e50: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
8e60: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 erver accept 883
8e70: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
8e80: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 {s a p} {.. t
8e90: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
8ea0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
8eb0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
8ec0: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
8ed0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
8ee0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
8ef0: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
8f00: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
8f10: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
8f20: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
8f30: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
8f40: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
8f50: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
8f60: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
8f70: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
8f80: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
8f90: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
8fa0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8fb0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8fc0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8fd0: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
8fe0: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 8836]. fco
8ff0: 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e nfigure $f -tran
9000: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
9010: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
9020: 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 puts $f hello.
9030: 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 set r [gets $
9040: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
9050: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9060: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
9070: 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _6_test_server}.
9080: 20 20 20 20 73 65 74 20 72 0a 7d 20 68 65 6c 6c set r.} hell
9090: 6f 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 o..test tlsIO-11
90a0: 2e 35 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c .5 {remote echo,
90b0: 20 35 30 20 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 50 lines} {sock
90c0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
90d0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
90e0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
90f0: 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 et caCert $caCer
9100: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
9110: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 nd "set serverCe
9120: 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a rt $serverCert".
9130: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9140: 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 "set clientCert
9150: 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 $clientCert".
9160: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
9170: 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 t serverKey $ser
9180: 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 verKey". send
9190: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
91a0: 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 entKey $clientKe
91b0: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
91c0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
91d0: 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 10_7_test_server
91e0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
91f0: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
9200: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
9210: 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 erCert \...-cafi
9220: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d le $caCert \...-
9230: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
9240: 65 79 20 5c 0a 09 09 38 38 33 36 5d 0a 09 70 72 ey \...8836]..pr
9250: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
9260: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
9270: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
9280: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
9290: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
92a0: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
92b0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
92c0: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
92d0: 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 tion crlf..}..pr
92e0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
92f0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
9300: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
9310: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
9320: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
9330: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
9340: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
9350: 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f set f [tls::so
9360: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
9370: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
9380: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9390: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
93a0: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
93b0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 moteServerIP 883
93c0: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
93d0: 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $f -translatio
93e0: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
93f0: 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b g line. for {
9400: 73 65 74 20 63 6e 74 20 30 7d 20 7b 24 63 6e 74 set cnt 0} {$cnt
9410: 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 63 6e 74 < 50} {incr cnt
9420: 7d 20 7b 0a 09 70 75 74 73 20 24 66 20 22 68 65 } {..puts $f "he
9430: 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 69 66 20 7b llo, $cnt"..if {
9440: 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 [string compare
9450: 5b 67 65 74 73 20 24 66 5d 20 22 68 65 6c 6c 6f [gets $f] "hello
9460: 2c 20 24 63 6e 74 22 5d 20 21 3d 20 30 7d 20 7b , $cnt"] != 0} {
9470: 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 .. break..}.
9480: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
9490: 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e f. sendComman
94a0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
94b0: 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 10_7_test_server
94c0: 7d 0a 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 }. set cnt.}
94d0: 35 30 0a 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 50..# Macintosh
94e0: 73 6f 63 6b 65 74 73 20 63 61 6e 20 68 61 76 65 sockets can have
94f0: 20 6d 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 more than one s
9500: 65 72 76 65 72 20 70 65 72 20 70 6f 72 74 0a 69 erver per port.i
9510: 66 20 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d f {$tcl_platform
9520: 28 70 6c 61 74 66 6f 72 6d 29 20 3d 3d 20 22 6d (platform) == "m
9530: 61 63 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 acintosh"} {.
9540: 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 set conflictRes
9550: 75 6c 74 20 7b 30 20 38 38 33 36 7d 0a 7d 20 65 ult {0 8836}.} e
9560: 6c 73 65 20 7b 0a 20 20 20 20 73 65 74 20 63 6f lse {. set co
9570: 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 20 nflictResult {1
9580: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
9590: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
95a0: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a lready in use}}.
95b0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 }..test tlsIO-11
95c0: 2e 36 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c .6 {socket confl
95d0: 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ict} {socket doT
95e0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
95f0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
9600: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
9610: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9620: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
9630: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9640: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
9650: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
9660: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 20 20 20 accept 8836].
9670: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 if {[catch {set
9680: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
9690: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
96a0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
96b0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
96c0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
96d0: 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 y \.. -server
96e0: 20 61 63 63 65 70 74 20 38 38 33 36 5d 7d 20 6d accept 8836]} m
96f0: 73 67 5d 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 sg]} {..set resu
9700: 6c 74 20 5b 6c 69 73 74 20 31 20 24 6d 73 67 5d lt [list 1 $msg]
9710: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
9720: 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 et result [list
9730: 30 20 5b 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 66 0 [lindex [fconf
9740: 69 67 75 72 65 20 24 73 32 20 2d 73 6f 63 6b 6e igure $s2 -sockn
9750: 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 ame] 2]]..close
9760: 24 73 32 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $s2. }. cl
9770: 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 ose $s1. set
9780: 72 65 73 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 result.} $confli
9790: 63 74 52 65 73 75 6c 74 0a 0a 74 65 73 74 20 74 ctResult..test t
97a0: 6c 73 49 4f 2d 31 31 2e 37 20 7b 73 65 72 76 65 lsIO-11.7 {serve
97b0: 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 r with several c
97c0: 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 lients} {socket
97d0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
97e0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
97f0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
9800: 74 20 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 t socket10_9_tes
9810: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
9820: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
9830: 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b ile [file join [
9840: 70 77 64 5d 20 63 65 72 74 73 20 73 65 72 76 65 pwd] certs serve
9850: 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 r.pem] \...-cafi
9860: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
9870: 77 64 5d 20 63 65 72 74 73 20 63 61 46 69 6c 65 wd] certs caFile
9880: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 .pem] \...-keyfi
9890: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
98a0: 77 64 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 wd] certs skey.p
98b0: 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 em] \...-server
98c0: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 accept 8836]..pr
98d0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
98e0: 7d 20 7b 0a 09 20 20 20 20 23 20 68 61 6e 64 73 } {.. # hands
98f0: 68 61 6b 65 20 6c 6f 63 6b 73 20 75 70 20 74 68 hake locks up th
9900: 65 20 74 68 72 65 65 20 73 79 6e 63 68 72 6f 6e e three synchron
9910: 6f 75 73 20 63 6c 69 65 6e 74 73 0a 09 20 20 20 ous clients..
9920: 20 23 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b # tls::handshak
9930: 65 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 e $s.. fconfi
9940: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
9950: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c ng line.. fil
9960: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
9970: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
9980: 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 ]..}..proc echo
9990: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
99a0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
99b0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
99c0: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
99d0: 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 } else {...puts
99e0: 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a $s $l.. }..}.
99f0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
9a00: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9a10: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9a20: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
9a30: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9a40: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
9a50: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
9a60: 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 verIP 8836].
9a70: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d fconfigure $s1 -
9a80: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
9a90: 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a set s2 [tls::
9aa0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9ab0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9ac0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9ad0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9ae0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
9af0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
9b00: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
9b10: 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 ure $s2 -bufferi
9b20: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
9b30: 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s3 [tls::socket
9b40: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9b50: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9b60: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9b70: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9b80: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9b90: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
9ba0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 fconfigure $s3
9bb0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
9bc0: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
9bd0: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
9be0: 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 ncr i} {..puts $
9bf0: 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 s1 hello,s1..get
9c00: 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 s $s1..puts $s2
9c10: 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 hello,s2..gets $
9c20: 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c s2..puts $s3 hel
9c30: 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a lo,s3..gets $s3.
9c40: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
9c50: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
9c60: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
9c70: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9c80: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
9c90: 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _9_test_server}.
9ca0: 20 20 20 20 73 65 74 20 69 0a 7d 20 31 30 30 20 set i.} 100
9cb0: 20 20 20 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ..test tlsIO-
9cc0: 31 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 11.8 {client wit
9cd0: 68 20 73 65 76 65 72 61 6c 20 73 65 72 76 65 72 h several server
9ce0: 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 s} {unexplainedH
9cf0: 61 6e 67 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 ang socket doTes
9d00: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9d10: 65 72 7d 20 7b 0a 20 20 20 20 23 20 74 68 69 73 er} {. # this
9d20: 20 6f 6e 65 20 73 65 65 6d 73 20 74 6f 20 68 61 one seems to ha
9d30: 6e 67 20 2d 2d 20 61 77 62 20 36 2f 32 2f 32 30 ng -- awb 6/2/20
9d40: 30 30 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 00. sendComma
9d50: 6e 64 20 7b 0a 09 73 65 74 20 73 31 20 5b 74 6c nd {..set s1 [tl
9d60: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 s::socket \...-c
9d70: 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f ertfile [file jo
9d80: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 in [pwd] certs s
9d90: 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d erver.pem] \...-
9da0: 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 cafile [file joi
9db0: 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 n [pwd] certs ca
9dc0: 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b File.pem] \...-k
9dd0: 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 eyfile [file joi
9de0: 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b n [pwd] certs sk
9df0: 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 ey.pem] \...-ser
9e00: 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 33 ver "accept 4003
9e10: 22 20 34 30 30 33 5d 0a 09 73 65 74 20 73 32 20 " 4003]..set s2
9e20: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
9e30: 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 .-certfile [file
9e40: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9e50: 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a s server.pem] \.
9e60: 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 ..-cafile [file
9e70: 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 join [pwd] certs
9e80: 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 caFile.pem] \..
9e90: 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 .-keyfile [file
9ea0: 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 join [pwd] certs
9eb0: 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d skey.pem] \...-
9ec0: 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 server "accept 4
9ed0: 30 30 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 004" 4004]..set
9ee0: 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s3 [tls::socket
9ef0: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 \...-certfile [f
9f00: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9f10: 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d erts server.pem]
9f20: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 \...-cafile [fi
9f30: 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 le join [pwd] ce
9f40: 72 74 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 rts caFile.pem]
9f50: 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 \...-keyfile [fi
9f60: 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 le join [pwd] ce
9f70: 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a rts skey.pem] \.
9f80: 09 09 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 ..-server "accep
9f90: 74 20 34 30 30 35 22 20 34 30 30 35 5d 0a 09 70 t 4005" 4005]..p
9fa0: 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 20 73 roc accept {mp s
9fb0: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
9fc0: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
9fd0: 20 20 20 20 70 75 74 73 20 24 73 20 24 6d 70 0a puts $s $mp.
9fe0: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d . close $s..}
9ff0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
a000: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 1 [tls::socket \
a010: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
a020: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
a030: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a040: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
a050: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
a060: 72 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 20 rverIP 4003].
a070: 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f set s2 [tls::so
a080: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
a090: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
a0a0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
a0b0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
a0c0: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
a0d0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
a0e0: 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 4]. set s3 [t
a0f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
a100: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
a110: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
a120: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
a130: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
a140: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
a150: 49 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 74 IP 4005]. set
a160: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
a170: 64 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 5b d l [gets $s1] [
a180: 67 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 24 gets $s1] [eof $
a190: 73 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b s1] [gets $s2] [
a1a0: 67 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 24 gets $s2] [eof $
a1b0: 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 33 s2] \..[gets $s3
a1c0: 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 6f ] [gets $s3] [eo
a1d0: 66 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 65 f $s3]. close
a1e0: 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s1. close $
a1f0: 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 s2. close $s3
a200: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a210: 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 63 {..close $s1..c
a220: 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 20 lose $s2..close
a230: 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s3. }. se
a240: 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 31 t l.} {4003 {} 1
a250: 20 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 20 4004 {} 1 4005
a260: 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 {} 1}..test tlsI
a270: 4f 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 63 O-11.9 {accept c
a280: 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b allback error} {
a290: 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 20 knownBug socket
a2a0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
a2b0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
a2c0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
a2d0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
a2e0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
a2f0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a300: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
a310: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
a320: 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 20 r accept 8836].
a330: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
a340: 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 s a p} {expr 10
a350: 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 / 0}. proc bg
a360: 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c error args {..gl
a370: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 obal x..set x $a
a380: 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 rgs. }. se
a390: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
a3a0: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
a3b0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a3c0: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
a3d0: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
a3e0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a3f0: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
a400: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
a410: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
a420: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
a430: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
a440: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
a450: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
a460: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 if {[catch {s
a470: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 endCommand {..
a480: 20 20 73 65 74 20 70 65 65 72 6e 61 6d 65 20 5b set peername [
a490: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 61 6c 6c fconfigure $call
a4a0: 65 72 53 6f 63 6b 65 74 20 2d 70 65 65 72 6e 61 erSocket -peerna
a4b0: 6d 65 5d 0a 09 20 20 20 20 73 65 74 20 73 20 5b me].. set s [
a4c0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
a4d0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
a4e0: 74 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c tCert \...-cafil
a4f0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b e $caCert \...-k
a500: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
a510: 79 20 5c 0a 09 20 20 20 20 09 5b 6c 69 6e 64 65 y \.. .[linde
a520: 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d 20 38 x $peername 0] 8
a530: 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 65 20 836].. close
a540: 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 67 5d $s. . }} msg]
a550: 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a 09 65 } {..close $s..e
a560: 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 7d 0a rror $msg. }.
a570: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
a580: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
a590: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
a5a0: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 vwait x. af
a5b0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
a5c0: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
a5d0: 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f rename bgerro
a5e0: 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d r {}. set x.}
a5f0: 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 72 {{divide by zer
a600: 6f 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d o}}..test tlsIO-
a610: 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 20 73 11.10 {testing s
a620: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
a630: 70 74 69 6f 6e 73 7d 20 7b 75 6e 65 78 70 6c 61 ptions} {unexpla
a640: 69 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b inedFailure sock
a650: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
a660: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
a670: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
a680: 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 et caCert $caCer
a690: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
a6a0: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 nd "set serverCe
a6b0: 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a rt $serverCert".
a6c0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a6d0: 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 "set clientCert
a6e0: 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 $clientCert".
a6f0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
a700: 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 t serverKey $ser
a710: 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 verKey". send
a720: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
a730: 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 entKey $clientKe
a740: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
a750: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
a760: 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 10_12_test_serve
a770: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
a780: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
a790: 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 rverCert \...-ca
a7a0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
a7b0: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
a7c0: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
a7d0: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 accept 8836]..p
a7e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
a7f0: 70 7d 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 p} {close $s}.
a800: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
a810: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
a820: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
a830: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
a840: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
a850: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
a860: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
a870: 49 50 20 38 38 33 36 5d 0a 20 20 20 20 73 65 74 IP 8836]. set
a880: 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 p [fconfigure $
a890: 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 s -peername].
a8a0: 20 73 65 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 set n [fconfigu
a8b0: 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d re $s -sockname]
a8c0: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
a8d0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
a8e0: 64 65 78 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 dex $p 2] [lleng
a8f0: 74 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 th $p] [llength
a900: 24 70 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $p]. close $s
a910: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a920: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
a930: 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 0_12_test_server
a940: 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 38 }. set l.} {8
a950: 38 33 36 20 33 20 33 7d 0a 0a 74 65 73 74 20 74 836 3 3}..test t
a960: 6c 73 49 4f 2d 31 31 2e 31 31 20 7b 74 65 73 74 lsIO-11.11 {test
a970: 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 ing spurious eve
a980: 6e 74 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 nts} {unexplaine
a990: 64 48 61 6e 67 20 73 6f 63 6b 65 74 20 64 6f 54 dHang socket doT
a9a0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
a9b0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 68 61 rver} {. # ha
a9c0: 6e 67 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ngs. sendComm
a9d0: 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 and "set caCert
a9e0: 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e $caCert". sen
a9f0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
aa00: 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 rverCert $server
aa10: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
aa20: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
aa30: 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 tCert $clientCer
aa40: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
aa50: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 nd "set serverKe
aa60: 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 y $serverKey".
aa70: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
aa80: 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c et clientKey $cl
aa90: 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e ientKey". sen
aaa0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
aab0: 73 6f 63 6b 65 74 31 30 5f 31 33 5f 74 65 73 74 socket10_13_test
aac0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
aad0: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
aae0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c le $serverCert \
aaf0: 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 ...-cafile $caCe
ab00: 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 rt \...-keyfile
ab10: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
ab20: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
ab30: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
ab40: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
ab50: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
ab60: 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 s.. fconfigur
ab70: 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $s -translatio
ab80: 6e 20 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 20 n "auto lf"..
ab90: 20 61 66 74 65 72 20 31 30 30 20 77 72 69 74 65 after 100 write
aba0: 73 6f 6d 65 20 24 73 0a 09 7d 0a 09 70 72 6f 63 some $s..}..proc
abb0: 20 77 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b writesome {s} {
abc0: 0a 09 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 .. for {set i
abd0: 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 0} {$i < 100} {
abe0: 69 6e 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 incr i} {...puts
abf0: 20 24 73 20 22 6c 69 6e 65 20 24 69 20 66 72 6f $s "line $i fro
ac00: 6d 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 22 m remote server"
ac10: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f .. }.. clo
ac20: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
ac30: 20 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 set len 0.
ac40: 20 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a set spurious 0.
ac50: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
ac60: 20 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 proc readlitt
ac70: 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c le {s} {..global
ac80: 20 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c spurious done l
ac90: 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 en..set l [read
aca0: 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 $s 1]..if {[stri
acb0: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d ng length $l] ==
acc0: 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 0} {.. if {!
acd0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e [eof $s]} {...in
ace0: 63 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 cr spurious..
acf0: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 } else {...clos
ad00: 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 e $s...set done
ad10: 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 1.. }..} else
ad20: 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e {.. incr len
ad30: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 [string length
ad40: 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $l]..}. }.
ad50: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
ad60: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
ad70: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
ad80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
ad90: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
ada0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
adb0: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
adc0: 5d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 ]. fileevent
add0: 24 63 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $c readable "rea
ade0: 64 6c 69 74 74 6c 65 20 24 63 22 0a 20 20 20 20 dlittle $c".
adf0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
ae00: 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 10000 "set done
ae10: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
ae20: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
ae30: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
ae40: 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d mer. sendComm
ae50: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
ae60: 65 74 31 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 et10_13_test_ser
ae70: 76 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 ver}. list $s
ae80: 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b purious $len.} {
ae90: 30 20 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 0 2690}..test tl
aea0: 73 49 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 sIO-11.12 {testi
aeb0: 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 ng EOF stickynes
aec0: 73 7d 20 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 s} {knownBug soc
aed0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
aee0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
aef0: 20 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 30 set counter 0
af00: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
af10: 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 proc count_u
af20: 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 p {s} {..global
af30: 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 counter done aft
af40: 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 er_id..set l [ge
af50: 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 ts $s]..if {[eof
af60: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 $s]} {.. inc
af70: 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 r counter.. i
af80: 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d f {$counter > 9}
af90: 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 {...set done {E
afa0: 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 OF is sticky}...
afb0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 66 after cancel $af
afc0: 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 ter_id...close $
afd0: 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 s.. }..}.
afe0: 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 64 }. proc timed
aff0: 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 _out {} {..globa
b000: 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f l c done..set do
b010: 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 ne {timed_out, E
b020: 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 OF is not sticky
b030: 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 }..close $c.
b040: 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e }. sendComman
b050: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
b060: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
b070: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
b080: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
b090: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
b0a0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
b0b0: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
b0c0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
b0d0: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
b0e0: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
b0f0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
b100: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
b110: 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 ntKey". sendC
b120: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
b130: 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 cket10_14_test_s
b140: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
b150: 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 et \...-certfile
b160: 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 $serverCert \..
b170: 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 .-cafile $caCert
b180: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 \...-keyfile $s
b190: 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 erverKey \...-se
b1a0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 rver accept 8836
b1b0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
b1c0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
b1d0: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
b1e0: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 20 63 . after 100 c
b1f0: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
b200: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
b210: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
b220: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
b230: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b240: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
b250: 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 lientKey \. .
b260: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
b270: 38 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 76 8836]. fileev
b280: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
b290: 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a 20 20 "count_up $c".
b2a0: 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 20 5b set after_id [
b2b0: 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 64 after 1000 timed
b2c0: 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 20 _out]. vwait
b2d0: 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 6f 6d done. sendCom
b2e0: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
b2f0: 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 ket10_14_test_se
b300: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 64 6f rver}. set do
b310: 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 74 69 ne.} {EOF is sti
b320: 63 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f cky}..test tlsIO
b330: 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e 67 20 -11.13 {testing
b340: 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 73 79 async write, asy
b350: 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e 63 20 nc flush, async
b360: 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65 close} \..{socke
b370: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
b380: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
b390: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
b3a0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
b3b0: 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 done..set l [re
b3c0: 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 ad $s]..incr cou
b3d0: 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 nt [string lengt
b3e0: 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 h $l]..if {[eof
b3f0: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 $s]} {.. clos
b400: 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f e $s.. set do
b410: 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 ne 1..}. }.
b420: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
b430: 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 et caCert $caCer
b440: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
b450: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 nd "set serverCe
b460: 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a rt $serverCert".
b470: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b480: 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 "set clientCert
b490: 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 $clientCert".
b4a0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
b4b0: 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 t serverKey $ser
b4c0: 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 verKey". send
b4d0: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
b4e0: 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 entKey $clientKe
b4f0: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
b500: 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 nd {..set firstb
b510: 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 lock ""..for {se
b520: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 t i 0} {$i < 5}
b530: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 73 65 74 {incr i} {...set
b540: 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 firstblock "a$f
b550: 69 72 73 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 irstblock$firstb
b560: 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 73 65 lock"..}..set se
b570: 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a 09 66 6f condblock ""..fo
b580: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
b590: 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b < 16} {incr i} {
b5a0: 0a 09 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 .. set second
b5b0: 62 6c 6f 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 block "b$secondb
b5c0: 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b lock$secondblock
b5d0: 22 0a 09 7d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 "..}..set l [tls
b5e0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 ::socket \...-ce
b5f0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
b600: 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 rt \...-cafile $
b610: 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 caCert \...-keyf
b620: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
b630: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
b640: 74 20 38 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 t 8845]..proc ac
b650: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
b660: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
b670: 6b 65 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 ke $s.. fconf
b680: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
b690: 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f ng 0 -translatio
b6a0: 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 n lf -buffersize
b6b0: 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 16384 \...-buff
b6c0: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 ering line..
b6d0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
b6e0: 64 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 dable "readable
b6f0: 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 65 61 $s"..}..proc rea
b700: 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 20 dable {s} {..
b710: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
b720: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
b730: 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 $s readable {}..
b740: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 72 after 1000 r
b750: 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 72 espond $s..}..pr
b760: 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b oc respond {s} {
b770: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 69 72 .. global fir
b780: 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 stblock.. put
b790: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 s -nonewline $s
b7a0: 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 $firstblock..
b7b0: 20 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 after 1000 writ
b7c0: 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 72 6f edata $s..}..pro
b7d0: 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 c writedata {s}
b7e0: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 65 {.. global se
b7f0: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 70 condblock.. p
b800: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
b810: 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 s $secondblock..
b820: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
b830: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
b840: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
b850: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
b860: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
b870: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b880: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
b890: 20 20 20 20 09 24 72 65 6d 6f 74 65 53 65 72 76 .$remoteServ
b8a0: 65 72 49 50 20 38 38 34 35 5d 0a 20 20 20 20 66 erIP 8845]. f
b8b0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
b8c0: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 ocking 0 -trans
b8d0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
b8e0: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
b8f0: 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 0. puts $s h
b900: 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 ello. fileeve
b910: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
b920: 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 readit $s". s
b930: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
b940: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
b950: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
b960: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
b970: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
b980: 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 er. sendComma
b990: 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 nd {close $l}.
b9a0: 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 set count.} 65
b9b0: 35 36 36 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 566..test tlsIO-
b9c0: 31 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.1 {testing in
b9d0: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 73 65 72 heritance of ser
b9e0: 76 65 72 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 ver sockets} \..
b9f0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
ba00: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
ba10: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
ba20: 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 e script1. re
ba30: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 moveFile script2
ba40: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 .. # Script1
ba50: 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 is just a 10 sec
ba60: 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 ond delay. If t
ba70: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
ba80: 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 . # is inheri
ba90: 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 ted, it will be
baa0: 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 held open for 10
bab0: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 seconds.. se
bac0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
bad0: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
bae0: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
baf0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
bb00: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
bb10: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 ose $f.. # Sc
bb20: 72 69 70 74 32 20 63 72 65 61 74 65 73 20 74 68 ript2 creates th
bb30: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c e server socket,
bb40: 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 launches script
bb50: 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 20 61 1,. # waits a
bb60: 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 second, and exi
bb70: 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 72 20 ts. The server
bb80: 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a socket will now.
bb90: 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20 # be closed
bba0: 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 20 69 unless script1 i
bbb0: 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 nherited it...
bbc0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
bbd0: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 23 20 70 ript2 w]. # p
bbe0: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
bbf0: 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 63 6c 74 tcltest $::tclt
bc00: 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 est::tcltest].
bc10: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
bc20: 73 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 set tclsh [info
bc30: 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 nameofexecutable
bc40: 5d 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]]. puts $f {
bc50: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
bc60: 65 20 74 63 6c 74 65 73 74 0a 09 70 61 63 6b 61 e tcltest..packa
bc70: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
bc80: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
bc90: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
bca0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
bcb0: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
bcc0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
bcd0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
bce0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 ile $serverKey 8
bcf0: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 828 \]". puts
bd00: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
bd10: 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 pt { file addr p
bd20: 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f ort } {.. clo
bd30: 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 23 20 65 se $file..}..# e
bd40: 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a xec $::tcltest::
bd50: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 20 tcltest script1
bd60: 26 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 &..exec $tclsh s
bd70: 63 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 20 cript1 &..close
bd80: 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 $f..after 1000 e
bd90: 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 xit..vwait forev
bda0: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
bdb0: 73 65 20 24 66 0a 09 0a 20 20 20 20 23 20 4c 61 se $f... # La
bdc0: 75 6e 63 68 20 73 63 72 69 70 74 32 20 61 6e 64 unch script2 and
bdd0: 20 77 61 69 74 20 35 20 73 65 63 6f 6e 64 73 0a wait 5 seconds.
bde0: 0a 20 20 20 20 23 20 65 78 65 63 20 24 3a 3a 74 . # exec $::t
bdf0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
be00: 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 65 78 script2 &. ex
be10: 65 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 ec [info nameofe
be20: 78 65 63 75 74 61 62 6c 65 5d 20 73 63 72 69 70 xecutable] scrip
be30: 74 32 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 t2 &. after 5
be40: 30 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 000 { set ok_to_
be50: 70 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 proceed 1 }.
be60: 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 vwait ok_to_proc
be70: 65 65 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 eed.. # If we
be80: 20 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 can still conne
be90: 63 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 ct to the server
bea0: 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 , the socket got
beb0: 20 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 inherited...
bec0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
bed0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
bee0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
bef0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
bf00: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
bf10: 6e 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 37 ntKey \. . 127
bf20: 2e 30 2e 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 .0.0.1 8828} msg
bf30: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 ]} {..set x {ser
bf40: 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ver socket was n
bf50: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 ot inherited}.
bf60: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 } else {..clos
bf70: 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 e $msg..set x {s
bf80: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
bf90: 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 inherited}.
bfa0: 7d 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c }.. removeFil
bfb0: 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 e script1. re
bfc0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 moveFile script2
bfd0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 . set x.} {se
bfe0: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
bff0: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
c000: 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 20 test tlsIO-12.2
c010: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
c020: 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 ance of client s
c030: 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 75 6e 65 78 ockets} \..{unex
c040: 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 plainedFailure s
c050: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
c060: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
c070: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
c080: 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f script1. remo
c090: 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 0a veFile script2..
c0a0: 20 20 20 20 23 20 53 63 72 69 70 74 31 20 69 73 # Script1 is
c0b0: 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e just a 10 secon
c0c0: 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 d delay. If the
c0d0: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 server socket.
c0e0: 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 # is inherite
c0f0: 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 d, it will be he
c100: 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 ld open for 10 s
c110: 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 econds.. set
c120: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 f [open script1
c130: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
c140: 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 ..after 10000 ex
c150: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
c160: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
c170: 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 e $f.. # Scri
c180: 70 74 32 20 6f 70 65 6e 73 20 74 68 65 20 63 6c pt2 opens the cl
c190: 69 65 6e 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 ient socket and
c1a0: 77 72 69 74 65 73 20 74 6f 20 69 74 2e 20 20 49 writes to it. I
c1b0: 74 20 74 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 t then. # lau
c1c0: 6e 63 68 65 73 20 73 63 72 69 70 74 31 20 61 6e nches script1 an
c1d0: 64 20 65 78 69 74 73 2e 20 20 49 66 20 74 68 65 d exits. If the
c1e0: 20 63 68 69 6c 64 20 70 72 6f 63 65 73 73 20 69 child process i
c1f0: 6e 68 65 72 69 74 65 64 20 74 68 65 0a 20 20 20 nherited the.
c200: 20 23 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 # client socket
c210: 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 77 69 6c , the socket wil
c220: 6c 20 73 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e l still be open.
c230: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
c240: 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 n script2 w].
c250: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
c260: 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 6e et tclsh [info n
c270: 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d ameofexecutable]
c280: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
c290: 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 .package req
c2a0: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 uire tls. }.
c2b0: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
c2c0: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
c2d0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
c2e0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
c2f0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
c300: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
c310: 30 2e 31 20 38 38 32 39 20 5c 5d 22 0a 20 20 20 0.1 8829 \]".
c320: 20 70 75 74 73 20 24 66 20 7b 0a 09 65 78 65 63 puts $f {..exec
c330: 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 $tclsh script1
c340: 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 69 &..puts $f testi
c350: 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 66 ng..flush $f..af
c360: 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 ter 1000 exit..v
c370: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
c380: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
c390: 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 74 68 . # Create th
c3a0: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a e server socket.
c3b0: 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 20 . set server
c3c0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
c3d0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
c3e0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
c3f0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
c400: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 2d 73 65 serverKey \..-se
c410: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 39 rver accept 8829
c420: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
c430: 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f t { file host po
c440: 72 74 20 7d 20 7b 0a 0a 09 23 20 57 68 65 6e 20 rt } {...# When
c450: 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 the client conne
c460: 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 20 74 cts, establish t
c470: 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 72 0a he read handler.
c480: 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a 09 .global server..
c490: 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a 09 66 close $server..f
c4a0: 69 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 20 72 ileevent $file r
c4b0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 eadable [list ge
c4c0: 74 64 61 74 61 20 24 66 69 6c 65 5d 0a 09 66 63 tdata $file]..fc
c4d0: 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d onfigure $file -
c4e0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
c4f0: 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 72 65 74 75 blocking 0..retu
c500: 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f rn. }. pro
c510: 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 6c 65 c getdata { file
c520: 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 61 } {...# Read ha
c530: 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 63 ndler on the acc
c540: 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 09 67 epted socket...g
c550: 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 lobal x..global
c560: 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 74 failed..set stat
c570: 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 us [catch {read
c580: 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 66 $file} data]..if
c590: 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d 20 {$status != 0}
c5a0: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 65 {.. set x {re
c5b0: 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 ad failed, error
c5c0: 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 20 was $data}..
c5d0: 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 catch { close $
c5e0: 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 66 file }..} elseif
c5f0: 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 {[string compar
c600: 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a 09 e {} $data]} {..
c610: 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 } elseif {[fbloc
c620: 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d ked $file]} {..}
c630: 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 elseif {[eof $f
c640: 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 ile]} {.. if
c650: 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 65 {$failed} {...se
c660: 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b t x {client sock
c670: 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 et was inherited
c680: 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a }.. } else {.
c690: 09 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 ..set x {client
c6a0: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
c6b0: 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d nherited}.. }
c6c0: 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c .. catch { cl
c6d0: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 ose $file }..} e
c6e0: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 lse {.. set x
c6f0: 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 {impossible cas
c700: 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 e}.. catch {
c710: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d close $file }..}
c720: 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a ..return. }..
c730: 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 # If the soc
c740: 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 20 ket doesn't hit
c750: 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 35 end-of-file in 5
c760: 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 20 seconds, the.
c770: 20 20 23 20 73 63 72 69 70 74 31 20 70 72 6f 63 # script1 proc
c780: 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 6e ess must have in
c790: 68 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 65 herited the clie
c7a0: 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 nt... set fai
c7b0: 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 led 0. after
c7c0: 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 66 5000 [list set f
c7d0: 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 20 ailed 1].. #
c7e0: 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 Launch the scrip
c7f0: 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 20 t2 process..
c800: 65 78 65 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f exec [info nameo
c810: 66 65 78 65 63 75 74 61 62 6c 65 5d 20 73 63 72 fexecutable] scr
c820: 69 70 74 32 20 26 0a 0a 20 20 20 20 76 77 61 69 ipt2 &.. vwai
c830: 74 20 78 0a 20 20 20 20 69 66 20 7b 21 24 66 61 t x. if {!$fa
c840: 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 iled} {..vwait f
c850: 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 ailed. }.
c860: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
c870: 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c t1. removeFil
c880: 65 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 e script2. se
c890: 74 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f t x.} {client so
c8a0: 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 cket was not inh
c8b0: 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c erited}..test tl
c8c0: 73 49 4f 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e sIO-12.3 {testin
c8d0: 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 g inheritance of
c8e0: 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 accepted socket
c8f0: 73 7d 20 5c 0a 09 7b 68 61 6e 67 73 4f 6e 4c 69 s} \..{hangsOnLi
c900: 6e 75 78 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 nux socket doTes
c910: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
c920: 65 72 7d 20 7b 0a 20 20 20 20 23 20 68 61 6e 67 er} {. # hang
c930: 73 20 6f 6e 20 4c 69 6e 75 78 0a 20 20 20 20 72 s on Linux. r
c940: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
c950: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
c960: 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 73 65 script2.. se
c970: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
c980: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
c990: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
c9a0: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
c9b0: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
c9c0: 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 65 74 20 ose $f.. set
c9d0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 f [open script2
c9e0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
c9f0: 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 5b list set tclsh [
ca00: 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 info nameofexecu
ca10: 74 61 62 6c 65 5d 5d 0a 20 20 20 20 70 75 74 73 table]]. puts
ca20: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
ca30: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
ca40: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
ca50: 20 22 63 61 74 63 68 20 7b 73 65 74 20 66 20 5c "catch {set f \
ca60: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
ca70: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
ca80: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
ca90: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
caa0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
cab0: 65 72 4b 65 79 20 38 39 33 30 20 5c 5d 7d 22 0a erKey 8930 \]}".
cac0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
cad0: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
cae0: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a e host port } {.
caf0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 73 . global tcls
cb00: 68 0a 09 20 20 20 20 70 75 74 73 20 24 66 69 6c h.. puts $fil
cb10: 65 20 7b 74 65 73 74 20 64 61 74 61 20 6f 6e 20 e {test data on
cb20: 73 6f 63 6b 65 74 7d 0a 09 20 20 20 20 65 78 65 socket}.. exe
cb30: 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 c $tclsh script1
cb40: 20 26 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 &.. after 10
cb50: 30 30 20 65 78 69 74 0a 09 7d 0a 09 63 61 74 63 00 exit..}..catc
cb60: 68 20 7b 76 77 61 69 74 20 66 6f 72 65 76 65 72 h {vwait forever
cb70: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 }. }. clos
cb80: 65 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e e $f.. # Laun
cb90: 63 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 ch the script2 p
cba0: 72 6f 63 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 rocess and conne
cbb0: 63 74 20 74 6f 20 69 74 2e 20 20 53 65 65 20 68 ct to it. See h
cbc0: 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 ow long. # th
cbd0: 65 20 73 6f 63 6b 65 74 20 73 74 61 79 73 20 6f e socket stays o
cbe0: 70 65 6e 0a 0a 20 20 20 20 65 78 65 63 20 5b 69 pen.. exec [i
cbf0: 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 nfo nameofexecut
cc00: 61 62 6c 65 5d 20 73 63 72 69 70 74 32 20 26 0a able] script2 &.
cc10: 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
cc20: 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 set ok_to_procee
cc30: 64 20 31 0a 20 20 20 20 76 77 61 69 74 20 6f 6b d 1. vwait ok
cc40: 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 _to_proceed..
cc50: 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 set f [tls::soc
cc60: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
cc70: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
cc80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
cc90: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
cca0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
ccb0: 30 2e 30 2e 31 20 38 39 33 30 5d 0a 20 20 20 20 0.0.1 8930].
ccc0: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 62 fconfigure $f -b
ccd0: 75 66 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d 62 uffering full -b
cce0: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 66 69 locking 0. fi
ccf0: 6c 65 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 leevent $f reada
cd00: 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 ble [list getdat
cd10: 61 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 a $f].. # If
cd20: 74 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 74 the socket is st
cd30: 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 35 ill open after 5
cd40: 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 seconds, the sc
cd50: 72 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 20 ript1 process.
cd60: 20 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 6e # must have in
cd70: 68 65 72 69 74 65 64 20 74 68 65 20 61 63 63 65 herited the acce
cd80: 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 pted socket...
cd90: 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 set failed 0.
cda0: 20 20 20 61 66 74 65 72 20 35 30 30 30 20 73 65 after 5000 se
cdb0: 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 t failed 1..
cdc0: 70 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 proc getdata { f
cdd0: 69 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 ile } {...# Read
cde0: 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 handler on the
cdf0: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2e 0a 09 client socket...
ce00: 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c global x..global
ce10: 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 failed..set sta
ce20: 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 tus [catch {read
ce30: 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 $file} data]..i
ce40: 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d f {$status != 0}
ce50: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 {.. set x {r
ce60: 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f ead failed, erro
ce70: 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 r was $data}..
ce80: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
ce90: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 $file }..} elsei
cea0: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
ceb0: 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a re {} $data]} {.
cec0: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f .} elseif {[fblo
ced0: 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 cked $file]} {..
cee0: 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 } elseif {[eof $
cef0: 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 file]} {.. if
cf00: 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 {$failed} {...s
cf10: 65 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 73 et x {accepted s
cf20: 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 ocket was inheri
cf30: 74 65 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 ted}.. } else
cf40: 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 63 65 {...set x {acce
cf50: 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 pted socket was
cf60: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 not inherited}..
cf70: 20 20 20 20 7d 0a 09 20 20 20 20 63 61 74 63 68 }.. catch
cf80: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
cf90: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
cfa0: 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c set x {impossibl
cfb0: 65 20 63 61 73 65 7d 0a 09 20 20 20 20 63 61 74 e case}.. cat
cfc0: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
cfd0: 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e 0a 20 20 }..}..return.
cfe0: 20 20 7d 0a 20 20 20 20 0a 20 20 20 20 76 77 61 }. . vwa
cff0: 69 74 20 78 0a 0a 20 20 20 20 72 65 6d 6f 76 65 it x.. remove
d000: 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 File script1.
d010: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
d020: 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 pt2. set x.}
d030: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
d040: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
d050: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
d060: 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 75 73 13.1 {Testing us
d070: 65 20 6f 66 20 73 68 61 72 65 64 20 73 6f 63 6b e of shared sock
d080: 65 74 20 62 65 74 77 65 65 6e 20 74 77 6f 20 74 et between two t
d090: 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b hreads} \..{sock
d0a0: 65 74 20 74 65 73 74 74 68 72 65 61 64 7d 20 7b et testthread} {
d0b0: 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 .. removeFile
d0c0: 20 73 63 72 69 70 74 0a 20 20 20 20 74 68 72 65 script. thre
d0d0: 61 64 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b 65 adReap.. make
d0e0: 46 69 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 6b File {. .pack
d0f0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
d100: 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 .set f [tls::soc
d110: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
d120: 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 20 61 pt 8828]..proc a
d130: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
d140: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 file
d150: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
d160: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
d170: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f . fco
d180: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
d190: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
d1a0: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
d1b0: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
d1c0: 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 al i.
d1d0: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
d1e0: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
d1f0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
d200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d210: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
d220: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
d230: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
d240: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
d250: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
d260: 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 se { ..
d270: 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 incr i.
d280: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
d290: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
d2a0: 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 }..}..set i 0..v
d2b0: 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 wait x..close $f
d2c0: 0a 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 61 ...# thread clea
d2d0: 6e 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 ns itself up...t
d2e0: 65 73 74 74 68 72 65 61 64 20 65 78 69 74 0a 20 estthread exit.
d2f0: 20 20 20 7d 20 73 63 72 69 70 74 0a 20 20 20 20 } script.
d300: 0a 20 20 20 20 23 20 63 72 65 61 74 65 20 61 20 . # create a
d310: 74 68 72 65 61 64 0a 20 20 20 20 73 65 74 20 73 thread. set s
d320: 65 72 76 65 72 74 68 72 65 61 64 20 5b 74 65 73 erverthread [tes
d330: 74 74 68 72 65 61 64 20 63 72 65 61 74 65 20 7b tthread create {
d340: 20 73 6f 75 72 63 65 20 73 63 72 69 70 74 20 7d source script }
d350: 20 5d 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 ]. update.
d360: 20 20 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 . after 100
d370: 30 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 0. set s [tls
d380: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
d390: 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 8828]. fco
d3a0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
d3b0: 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 ering line..
d3c0: 63 61 74 63 68 20 7b 0a 09 70 75 74 73 20 24 73 catch {..puts $s
d3d0: 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 "hello"..gets $
d3e0: 73 20 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 s result. }.
d3f0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
d400: 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 update.. afte
d410: 72 20 32 30 30 30 0a 20 20 20 20 6c 61 70 70 65 r 2000. lappe
d420: 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 72 65 61 nd result [threa
d430: 64 52 65 61 70 5d 0a 20 20 20 20 0a 20 20 20 20 dReap]. .
d440: 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 set result..} {h
d450: 65 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c 65 61 6e ello 1}..# clean
d460: 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d up.if {[string m
d470: 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d atch sock* $comm
d480: 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d andSocket] == 1}
d490: 20 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 6d 6d {. puts $comm
d4a0: 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 0a 20 andSocket exit.
d4b0: 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 6e 64 flush $command
d4c0: 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 20 7b Socket.}.catch {
d4d0: 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f close $commandSo
d4e0: 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 6c 6f cket}.catch {clo
d4f0: 73 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 43 68 se $remoteProcCh
d500: 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 an}.::tcltest::c
d510: 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 6c 75 73 leanupTests.flus
d520: 68 20 73 74 64 6f 75 74 0a 72 65 74 75 72 6e 0a h stdout.return.
d530: 0a .