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 31 39 39 39 20 62 79 20 53 63 72 69 70 98-1999 by Scrip
0150: 74 69 63 73 20 43 6f 72 70 6f 72 61 74 69 6f 6e tics Corporation
0160: 2e 0a 23 0a 23 20 53 65 65 20 74 68 65 20 66 69 ..#.# See the fi
0170: 6c 65 20 22 6c 69 63 65 6e 73 65 2e 74 65 72 6d le "license.term
0180: 73 22 20 66 6f 72 20 69 6e 66 6f 72 6d 61 74 69 s" for informati
0190: 6f 6e 20 6f 6e 20 75 73 61 67 65 20 61 6e 64 20 on on usage and
01a0: 72 65 64 69 73 74 72 69 62 75 74 69 6f 6e 0a 23 redistribution.#
01b0: 20 6f 66 20 74 68 69 73 20 66 69 6c 65 2c 20 61 of this file, a
01c0: 6e 64 20 66 6f 72 20 61 20 44 49 53 43 4c 41 49 nd for a DISCLAI
01d0: 4d 45 52 20 4f 46 20 41 4c 4c 20 57 41 52 52 41 MER OF ALL WARRA
01e0: 4e 54 49 45 53 2e 0a 23 0a 23 20 52 43 53 3a 20 NTIES..#.# RCS:
01f0: 40 28 23 29 20 24 49 64 3a 20 74 6c 73 49 6f 2e @(#) $Id: tlsIo.
0200: 74 65 73 74 2c 76 20 31 2e 35 20 32 30 30 30 2f test,v 1.5 2000/
0210: 30 36 2f 30 32 20 32 31 3a 35 30 3a 34 34 20 61 06/02 21:50:44 a
0220: 77 62 20 45 78 70 20 24 0a 0a 23 20 52 75 6e 6e wb Exp $..# Runn
0230: 69 6e 67 20 73 6f 63 6b 65 74 20 74 65 73 74 73 ing socket tests
0240: 20 77 69 74 68 20 61 20 72 65 6d 6f 74 65 20 73 with a remote s
0250: 65 72 76 65 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d erver:.# -------
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 2d 0a 23 20 0a 23 20 53 6f 6d 65 20 74 65 ---.# .# Some te
0290: 73 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 sts in socket.te
02a0: 73 74 20 64 65 70 65 6e 64 20 6f 6e 20 74 68 65 st depend on the
02b0: 20 65 78 69 73 74 65 6e 63 65 20 6f 66 20 61 20 existence of a
02c0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 74 6f remote server to
02d0: 0a 23 20 77 68 69 63 68 20 74 68 65 79 20 63 6f .# which they co
02e0: 6e 6e 65 63 74 2e 20 54 68 65 20 72 65 6d 6f 74 nnect. The remot
02f0: 65 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 e server must be
0300: 20 61 6e 20 69 6e 73 74 61 6e 63 65 20 6f 66 20 an instance of
0310: 74 63 6c 74 65 73 74 20 61 6e 64 20 69 74 0a 23 tcltest and it.#
0320: 20 6d 75 73 74 20 72 75 6e 20 74 68 65 20 73 63 must run the sc
0330: 72 69 70 74 20 66 6f 75 6e 64 20 69 6e 20 74 68 ript found in th
0340: 65 20 66 69 6c 65 20 22 72 65 6d 6f 74 65 2e 74 e file "remote.t
0350: 63 6c 22 20 69 6e 20 74 68 69 73 20 64 69 72 65 cl" in this dire
0360: 63 74 6f 72 79 2e 20 59 6f 75 0a 23 20 63 61 6e ctory. You.# can
0370: 20 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 start the remot
0380: 65 20 73 65 72 76 65 72 20 6f 6e 20 61 6e 79 20 e server on any
0390: 6d 61 63 68 69 6e 65 20 72 65 61 63 68 61 62 6c machine reachabl
03a0: 65 20 66 72 6f 6d 20 74 68 65 20 6d 61 63 68 69 e from the machi
03b0: 6e 65 20 6f 6e 0a 23 20 77 68 69 63 68 20 79 6f ne on.# which yo
03c0: 75 20 77 61 6e 74 20 74 6f 20 72 75 6e 20 74 68 u want to run th
03d0: 65 20 73 6f 63 6b 65 74 20 74 65 73 74 73 2c 20 e socket tests,
03e0: 62 79 20 69 73 73 75 69 6e 67 3a 0a 23 20 0a 23 by issuing:.# .#
03f0: 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d tcltest rem
0400: 6f 74 65 2e 74 63 6c 20 2d 70 6f 72 74 20 32 30 ote.tcl -port 20
0410: 34 38 09 23 20 4f 72 20 63 68 6f 6f 73 65 20 61 48.# Or choose a
0420: 6e 6f 74 68 65 72 20 70 6f 72 74 20 6e 75 6d 62 nother port numb
0430: 65 72 2e 0a 23 20 0a 23 20 49 66 20 74 68 65 20 er..# .# If the
0440: 6d 61 63 68 69 6e 65 20 79 6f 75 20 61 72 65 20 machine you are
0450: 72 75 6e 6e 69 6e 67 20 74 68 65 20 72 65 6d 6f running the remo
0460: 74 65 20 73 65 72 76 65 72 20 6f 6e 20 68 61 73 te server on has
0470: 20 73 65 76 65 72 61 6c 20 49 50 0a 23 20 69 6e several IP.# in
0480: 74 65 72 66 61 63 65 73 2c 20 79 6f 75 20 63 61 terfaces, you ca
0490: 6e 20 63 68 6f 6f 73 65 20 77 68 69 63 68 20 69 n choose which i
04a0: 6e 74 65 72 66 61 63 65 20 74 68 65 20 73 65 72 nterface the ser
04b0: 76 65 72 20 6c 69 73 74 65 6e 73 20 6f 6e 20 66 ver listens on f
04c0: 6f 72 0a 23 20 63 6f 6e 6e 65 63 74 69 6f 6e 73 or.# connections
04d0: 20 62 79 20 73 70 65 63 69 66 79 69 6e 67 20 74 by specifying t
04e0: 68 65 20 2d 61 64 64 72 65 73 73 20 63 6f 6d 6d he -address comm
04f0: 61 6e 64 20 6c 69 6e 65 20 66 6c 61 67 2c 20 73 and line flag, s
0500: 6f 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 o:.# .# tclt
0510: 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d est remote.tcl -
0520: 61 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 address your.mac
0530: 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 54 68 hine.com.# .# Th
0540: 65 73 65 20 6f 70 74 69 6f 6e 73 20 63 61 6e 20 ese options can
0550: 61 6c 73 6f 20 62 65 20 73 65 74 20 62 79 20 65 also be set by e
0560: 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 nvironment varia
0570: 62 6c 65 73 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 bles. On Unix, y
0580: 6f 75 20 63 61 6e 0a 23 20 74 79 70 65 20 74 68 ou can.# type th
0590: 65 73 65 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 ese commands to
05a0: 74 68 65 20 73 68 65 6c 6c 20 66 72 6f 6d 20 77 the shell from w
05b0: 68 69 63 68 20 74 68 65 20 72 65 6d 6f 74 65 20 hich the remote
05c0: 73 65 72 76 65 72 20 69 73 20 73 74 61 72 74 65 server is starte
05d0: 64 3a 0a 23 20 0a 23 20 20 20 20 20 73 68 65 6c d:.# .# shel
05e0: 6c 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 l% setenv server
05f0: 50 6f 72 74 20 32 30 34 38 0a 23 20 20 20 20 20 Port 2048.#
0600: 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 73 65 shell% setenv se
0610: 72 76 65 72 41 64 64 72 65 73 73 20 79 6f 75 72 rverAddress your
0620: 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a .machine.com.# .
0630: 23 20 61 6e 64 20 73 75 62 73 65 71 75 65 6e 74 # and subsequent
0640: 6c 79 20 79 6f 75 20 63 61 6e 20 73 74 61 72 74 ly you can start
0650: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
0660: 65 72 20 77 69 74 68 3a 0a 23 20 0a 23 20 20 20 er with:.# .#
0670: 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 tcltest remote
0680: 2e 74 63 6c 0a 23 20 0a 23 20 74 6f 20 68 61 76 .tcl.# .# to hav
0690: 65 20 69 74 20 6c 69 73 74 65 6e 20 6f 6e 20 70 e it listen on p
06a0: 6f 72 74 20 32 30 34 38 20 6f 6e 20 74 68 65 20 ort 2048 on the
06b0: 69 6e 74 65 72 66 61 63 65 20 79 6f 75 72 2e 6d interface your.m
06c0: 61 63 68 69 6e 65 2e 63 6f 6d 2e 0a 23 20 20 20 achine.com..#
06d0: 20 20 0a 23 20 57 68 65 6e 20 74 68 65 20 73 65 .# When the se
06e0: 72 76 65 72 20 73 74 61 72 74 73 2c 20 69 74 20 rver starts, it
06f0: 70 72 69 6e 74 73 20 6f 75 74 20 61 20 64 65 74 prints out a det
0700: 61 69 6c 65 64 20 6d 65 73 73 61 67 65 20 63 6f ailed message co
0710: 6e 74 61 69 6e 69 6e 67 20 69 74 73 0a 23 20 63 ntaining its.# c
0720: 6f 6e 66 69 67 75 72 61 74 69 6f 6e 20 69 6e 66 onfiguration inf
0730: 6f 72 6d 61 74 69 6f 6e 2c 20 61 6e 64 20 69 74 ormation, and it
0740: 20 77 69 6c 6c 20 62 6c 6f 63 6b 20 75 6e 74 69 will block unti
0750: 6c 20 6b 69 6c 6c 65 64 20 77 69 74 68 20 61 20 l killed with a
0760: 43 74 72 6c 2d 43 2e 0a 23 20 4f 6e 63 65 20 74 Ctrl-C..# Once t
0770: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
0780: 20 65 78 69 73 74 73 2c 20 79 6f 75 20 63 61 6e exists, you can
0790: 20 72 75 6e 20 74 68 65 20 74 65 73 74 73 20 69 run the tests i
07a0: 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 77 69 n socket.test wi
07b0: 74 68 0a 23 20 74 68 65 20 73 65 72 76 65 72 20 th.# the server
07c0: 62 79 20 73 65 74 74 69 6e 67 20 74 77 6f 20 54 by setting two T
07d0: 63 6c 20 76 61 72 69 61 62 6c 65 73 3a 0a 23 20 cl variables:.#
07e0: 0a 23 20 20 20 20 20 25 20 73 65 74 20 72 65 6d .# % set rem
07f0: 6f 74 65 53 65 72 76 65 72 49 50 20 3c 6e 61 6d oteServerIP <nam
0800: 65 20 6f 72 20 61 64 64 72 65 73 73 20 6f 66 20 e or address of
0810: 6d 61 63 68 69 6e 65 20 6f 6e 20 77 68 69 63 68 machine on which
0820: 20 73 65 72 76 65 72 20 72 75 6e 73 3e 0a 23 20 server runs>.#
0830: 20 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 % set remote
0840: 53 65 72 76 65 72 50 6f 72 74 20 32 30 34 38 0a ServerPort 2048.
0850: 23 20 0a 23 20 54 68 65 73 65 20 76 61 72 69 61 # .# These varia
0860: 62 6c 65 73 20 61 72 65 20 61 6c 73 6f 20 73 65 bles are also se
0870: 74 74 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 20 ttable from the
0880: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 environment. On
0890: 55 6e 69 78 2c 20 79 6f 75 20 63 61 6e 3a 0a 23 Unix, you can:.#
08a0: 20 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 .# shell% s
08b0: 65 74 65 6e 76 20 72 65 6d 6f 74 65 53 65 72 76 etenv remoteServ
08c0: 65 72 49 50 20 6d 61 63 68 69 6e 65 2e 77 68 65 erIP machine.whe
08d0: 72 65 2e 73 65 72 76 65 72 2e 72 75 6e 73 0a 23 re.server.runs.#
08e0: 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 6e 65 shell% sene
08f0: 74 76 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 tv remoteServerP
0900: 6f 72 74 20 32 30 34 38 0a 23 20 0a 23 20 54 68 ort 2048.# .# Th
0910: 65 20 70 72 65 61 6d 62 6c 65 20 6f 66 20 74 68 e preamble of th
0920: 65 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 69 e socket.test fi
0930: 6c 65 20 63 68 65 63 6b 73 20 74 6f 20 73 65 65 le checks to see
0940: 20 69 66 20 74 68 65 20 76 61 72 69 61 62 6c 65 if the variable
0950: 73 20 61 72 65 20 73 65 74 0a 23 20 65 69 74 68 s are set.# eith
0960: 65 72 20 69 6e 20 54 63 6c 20 6f 72 20 69 6e 20 er in Tcl or in
0970: 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 3b the environment;
0980: 20 69 66 20 74 68 65 79 20 61 72 65 2c 20 69 74 if they are, it
0990: 20 61 74 74 65 6d 70 74 73 20 74 6f 20 63 6f 6e attempts to con
09a0: 6e 65 63 74 20 74 6f 0a 23 20 74 68 65 20 73 65 nect to.# the se
09b0: 72 76 65 72 2e 20 49 66 20 74 68 65 20 63 6f 6e rver. If the con
09c0: 6e 65 63 74 69 6f 6e 20 69 73 20 73 75 63 63 65 nection is succe
09d0: 73 73 66 75 6c 2c 20 74 68 65 20 74 65 73 74 73 ssful, the tests
09e0: 20 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 using the remot
09f0: 65 0a 23 20 73 65 72 76 65 72 20 77 69 6c 6c 20 e.# server will
0a00: 62 65 20 70 65 72 66 6f 72 6d 65 64 3b 20 6f 74 be performed; ot
0a10: 68 65 72 77 69 73 65 2c 20 69 74 20 77 69 6c 6c herwise, it will
0a20: 20 61 74 74 65 6d 70 74 20 74 6f 20 73 74 61 72 attempt to star
0a30: 74 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 t the remote.# s
0a40: 65 72 76 65 72 20 28 76 69 61 20 65 78 65 63 29 erver (via exec)
0a50: 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 on platforms th
0a60: 61 74 20 73 75 70 70 6f 72 74 20 74 68 69 73 2c at support this,
0a70: 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f on the local ho
0a80: 73 74 2c 0a 23 20 6c 69 73 74 65 6e 69 6e 67 20 st,.# listening
0a90: 61 74 20 70 6f 72 74 20 32 30 34 38 2e 20 49 66 at port 2048. If
0aa0: 20 61 6c 6c 20 66 61 69 6c 73 2c 20 61 20 6d 65 all fails, a me
0ab0: 73 73 61 67 65 20 69 73 20 70 72 69 6e 74 65 64 ssage is printed
0ac0: 20 61 6e 64 20 74 68 65 20 74 65 73 74 73 0a 23 and the tests.#
0ad0: 20 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 using the remot
0ae0: 65 20 73 65 72 76 65 72 20 61 72 65 20 6e 6f 74 e server are not
0af0: 20 70 65 72 66 6f 72 6d 65 64 2e 0a 0a 69 66 20 performed...if
0b00: 7b 5b 6c 73 65 61 72 63 68 20 5b 6e 61 6d 65 73 {[lsearch [names
0b10: 70 61 63 65 20 63 68 69 6c 64 72 65 6e 5d 20 3a pace children] :
0b20: 3a 74 63 6c 74 65 73 74 5d 20 3d 3d 20 2d 31 7d :tcltest] == -1}
0b30: 20 7b 0a 20 20 20 20 70 61 63 6b 61 67 65 20 72 {. package r
0b40: 65 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a 20 equire tcltest.
0b50: 20 20 20 6e 61 6d 65 73 70 61 63 65 20 69 6d 70 namespace imp
0b60: 6f 72 74 20 2d 66 6f 72 63 65 20 3a 3a 74 63 6c ort -force ::tcl
0b70: 74 65 73 74 3a 3a 2a 0a 7d 0a 0a 23 20 4c 6f 61 test::*.}..# Loa
0b80: 64 20 74 68 65 20 74 6c 73 20 70 61 63 6b 61 67 d the tls packag
0b90: 65 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 e.package requir
0ba0: 65 20 74 6c 73 0a 0a 73 65 74 20 73 65 72 76 65 e tls..set serve
0bb0: 72 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f 69 6e rCert [file join
0bc0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 $::tcltest::tes
0bd0: 74 73 44 69 72 65 63 74 6f 72 79 20 63 65 72 74 tsDirectory cert
0be0: 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a 73 65 s server.pem].se
0bf0: 74 20 63 6c 69 65 6e 74 43 65 72 74 20 5b 66 69 t clientCert [fi
0c00: 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 63 6c 74 65 le join $::tclte
0c10: 73 74 3a 3a 74 65 73 74 73 44 69 72 65 63 74 6f st::testsDirecto
0c20: 72 79 20 63 65 72 74 73 20 63 6c 69 65 6e 74 2e ry certs client.
0c30: 70 65 6d 5d 0a 73 65 74 20 63 61 43 65 72 74 20 pem].set caCert
0c40: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 63 [file join $::tc
0c50: 6c 74 65 73 74 3a 3a 74 65 73 74 73 44 69 72 65 ltest::testsDire
0c60: 63 74 6f 72 79 20 63 65 72 74 73 20 63 61 63 65 ctory certs cace
0c70: 72 74 2e 70 65 6d 5d 0a 73 65 74 20 73 65 72 76 rt.pem].set serv
0c80: 65 72 4b 65 79 20 5b 66 69 6c 65 20 6a 6f 69 6e erKey [file join
0c90: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 $::tcltest::tes
0ca0: 74 73 44 69 72 65 63 74 6f 72 79 20 63 65 72 74 tsDirectory cert
0cb0: 73 20 73 6b 65 79 2e 70 65 6d 5d 0a 73 65 74 20 s skey.pem].set
0cc0: 63 6c 69 65 6e 74 4b 65 79 20 5b 66 69 6c 65 20 clientKey [file
0cd0: 6a 6f 69 6e 20 24 3a 3a 74 63 6c 74 65 73 74 3a join $::tcltest:
0ce0: 3a 74 65 73 74 73 44 69 72 65 63 74 6f 72 79 20 :testsDirectory
0cf0: 63 65 72 74 73 20 63 6b 65 79 2e 70 65 6d 5d 0a certs ckey.pem].
0d00: 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 72 65 .# Some tests re
0d10: 71 75 69 72 65 20 74 68 65 20 74 65 73 74 74 68 quire the testth
0d20: 72 65 61 64 20 63 6f 6d 6d 61 6e 64 0a 0a 73 65 read command..se
0d30: 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 t ::tcltest::tes
0d40: 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 74 65 73 tConstraints(tes
0d50: 74 74 68 72 65 61 64 29 20 5c 0a 09 5b 65 78 70 tthread) \..[exp
0d60: 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 r {[info command
0d70: 73 20 74 65 73 74 74 68 72 65 61 64 5d 20 21 3d s testthread] !=
0d80: 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 49 66 20 72 65 {}}]..#.# If re
0d90: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 6f 72 20 moteServerIP or
0da0: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
0db0: 20 61 72 65 20 6e 6f 74 20 73 65 74 2c 20 63 68 are not set, ch
0dc0: 65 63 6b 20 69 6e 20 74 68 65 0a 23 20 65 6e 76 eck in the.# env
0dd0: 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 6c ironment variabl
0de0: 65 73 20 66 6f 72 20 65 78 74 65 72 6e 61 6c 6c es for externall
0df0: 79 20 73 65 74 20 76 61 6c 75 65 73 2e 0a 23 0a y set values..#.
0e00: 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 .if {![info exis
0e10: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 ts remoteServerI
0e20: 50 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 P]} {. if {[i
0e30: 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 nfo exists env(r
0e40: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 5d 7d emoteServerIP)]}
0e50: 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 {..set remoteSe
0e60: 72 76 65 72 49 50 20 24 65 6e 76 28 72 65 6d 6f rverIP $env(remo
0e70: 74 65 53 65 72 76 65 72 49 50 29 0a 20 20 20 20 teServerIP).
0e80: 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 }.}.if {![info e
0e90: 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 xists remoteServ
0ea0: 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 20 69 erPort]} {. i
0eb0: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0ec0: 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 env(remoteServer
0ed0: 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d IP)]} {..set rem
0ee0: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 65 oteServerPort $e
0ef0: 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 50 nv(remoteServerP
0f00: 6f 72 74 29 0a 20 20 20 20 7d 20 65 6c 73 65 20 ort). } else
0f10: 7b 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b 69 {. if {[i
0f20: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 nfo exists remot
0f30: 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 09 20 eServerIP]} {..
0f40: 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 set remoteSer
0f50: 76 65 72 50 6f 72 74 20 32 30 34 38 0a 20 20 20 verPort 2048.
0f60: 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 7d 0a 0a }. }.}..
0f70: 23 0a 23 20 43 68 65 63 6b 20 69 66 20 77 65 27 #.# Check if we'
0f80: 72 65 20 73 75 70 70 6f 73 65 64 20 74 6f 20 64 re supposed to d
0f90: 6f 20 74 65 73 74 73 20 61 67 61 69 6e 73 74 20 o tests against
0fa0: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
0fb0: 72 0a 23 0a 0a 73 65 74 20 64 6f 54 65 73 74 73 r.#..set doTests
0fc0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
0fd0: 20 31 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 1.if {![info ex
0fe0: 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 ists remoteServe
0ff0: 72 49 50 5d 20 26 26 20 28 24 74 63 6c 5f 70 6c rIP] && ($tcl_pl
1000: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 atform(platform)
1010: 20 21 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 29 != "macintosh")
1020: 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 65 6d 6f } {. set remo
1030: 74 65 53 65 72 76 65 72 49 50 20 31 32 37 2e 30 teServerIP 127.0
1040: 2e 30 2e 31 0a 7d 0a 69 66 20 7b 28 24 64 6f 54 .0.1.}.if {($doT
1050: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1060: 72 76 65 72 20 3d 3d 20 31 29 20 26 26 20 28 21 rver == 1) && (!
1070: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
1080: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 29 7d oteServerPort])}
1090: 20 7b 0a 20 20 20 20 73 65 74 20 72 65 6d 6f 74 {. set remot
10a0: 65 53 65 72 76 65 72 50 6f 72 74 20 32 30 34 38 eServerPort 2048
10b0: 0a 7d 0a 0a 23 20 41 74 74 65 6d 70 74 20 74 6f .}..# Attempt to
10c0: 20 63 6f 6e 6e 65 63 74 20 74 6f 20 61 20 72 65 connect to a re
10d0: 6d 6f 74 65 20 73 65 72 76 65 72 20 69 66 20 6f mote server if o
10e0: 6e 65 20 69 73 20 61 6c 72 65 61 64 79 20 72 75 ne is already ru
10f0: 6e 6e 69 6e 67 2e 20 49 66 20 69 74 0a 23 20 69 nning. If it.# i
1100: 73 20 6e 6f 74 20 72 75 6e 6e 69 6e 67 20 6f 72 s not running or
1110: 20 66 6f 72 20 73 6f 6d 65 20 6f 74 68 65 72 20 for some other
1120: 72 65 61 73 6f 6e 20 74 68 65 20 63 6f 6e 6e 65 reason the conne
1130: 63 74 20 66 61 69 6c 73 2c 20 61 74 74 65 6d 70 ct fails, attemp
1140: 74 20 74 6f 0a 23 20 73 74 61 72 74 20 74 68 65 t to.# start the
1150: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6f remote server o
1160: 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f 73 74 n the local host
1170: 20 6c 69 73 74 65 6e 69 6e 67 20 6f 6e 20 70 6f listening on po
1180: 72 74 20 32 30 34 38 2e 20 54 68 69 73 0a 23 20 rt 2048. This.#
1190: 69 73 20 6f 6e 6c 79 20 64 6f 6e 65 20 6f 6e 20 is only done on
11a0: 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 73 platforms that s
11b0: 75 70 70 6f 72 74 20 65 78 65 63 20 28 69 2e 65 upport exec (i.e
11c0: 2e 20 6e 6f 74 20 6f 6e 20 74 68 65 20 4d 61 63 . not on the Mac
11d0: 29 2e 20 4f 6e 0a 23 20 70 6c 61 74 66 6f 72 6d ). On.# platform
11e0: 73 20 74 68 61 74 20 64 6f 20 6e 6f 74 20 73 75 s that do not su
11f0: 70 70 6f 72 74 20 65 78 65 63 2c 20 74 68 65 20 pport exec, the
1200: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 6d 75 remote server mu
1210: 73 74 20 62 65 20 73 74 61 72 74 65 64 0a 23 20 st be started.#
1220: 62 79 20 74 68 65 20 75 73 65 72 20 62 65 66 6f by the user befo
1230: 72 65 20 72 75 6e 6e 69 6e 67 20 74 68 65 20 74 re running the t
1240: 65 73 74 73 2e 0a 0a 73 65 74 20 72 65 6d 6f 74 ests...set remot
1250: 65 50 72 6f 63 43 68 61 6e 20 22 22 0a 73 65 74 eProcChan "".set
1260: 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 commandSocket "
1270: 22 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 ".if {$doTestsWi
1280: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
1290: 7b 0a 20 20 20 20 63 61 74 63 68 20 7b 63 6c 6f {. catch {clo
12a0: 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 se $commandSocke
12b0: 74 7d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 t}. if {[catc
12c0: 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f h {set commandSo
12d0: 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 cket [tls::socke
12e0: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
12f0: 50 20 5c 0a 09 09 09 09 09 09 24 72 65 6d 6f 74 P \.......$remot
1300: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d 20 21 eServerPort]}] !
1310: 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 = 0} {..if {[inf
1320: 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d o commands exec]
1330: 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 73 == ""} {.. s
1340: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1350: 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 78 65 eason "can't exe
1360: 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f 54 65 c".. set doTe
1370: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1380: 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a ver 0..} else {.
1390: 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 . set remoteS
13a0: 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e erverIP 127.0.0.
13b0: 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 1.. set remot
13c0: 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e eFile [file join
13d0: 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e 74 63 [pwd] remote.tc
13e0: 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 74 l].. if {[cat
13f0: 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 50 72 ch {set remotePr
1400: 6f 63 43 68 61 6e 20 5c 0a 09 09 09 09 5b 6f 70 ocChan \.....[op
1410: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
1420: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 24 ltest::tcltest $
1430: 72 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 09 09 remoteFile \....
1440: 09 09 2d 73 65 72 76 65 72 49 73 53 69 6c 65 6e ..-serverIsSilen
1450: 74 20 5c 0a 09 09 09 09 09 2d 70 6f 72 74 20 24 t \......-port $
1460: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
1470: 20 5c 0a 09 09 09 09 09 2d 61 64 64 72 65 73 73 \......-address
1480: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
1490: 5d 22 20 5c 0a 09 09 09 09 09 77 2b 5d 7d 20 5c ]" \......w+]} \
14a0: 0a 09 09 20 20 20 6d 73 67 5d 20 3d 3d 20 30 7d ... msg] == 0}
14b0: 20 7b 0a 09 09 61 66 74 65 72 20 31 30 30 30 0a {...after 1000.
14c0: 09 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 ..if {[catch {se
14d0: 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 t commandSocket
14e0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
14f0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 5c 0a 09 moteServerIP \..
1500: 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 ...$remoteServer
1510: 50 6f 72 74 5d 7d 20 6d 73 67 5d 20 3d 3d 20 30 Port]} msg] == 0
1520: 7d 20 7b 0a 09 09 20 20 20 20 66 63 6f 6e 66 69 } {... fconfi
1530: 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 gure $commandSoc
1540: 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ket -translation
1550: 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 crlf -buffering
1560: 20 6c 69 6e 65 0a 09 09 7d 20 65 6c 73 65 20 7b line...} else {
1570: 0a 09 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d ... set noRem
1580: 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 24 6d oteTestReason $m
1590: 73 67 0a 09 09 20 20 20 20 73 65 74 20 64 6f 54 sg... set doT
15a0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
15b0: 72 76 65 72 20 30 0a 09 09 7d 0a 09 20 20 20 20 rver 0...}..
15c0: 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 6e } else {...set n
15d0: 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f oRemoteTestReaso
15e0: 6e 20 22 24 6d 73 67 20 24 3a 3a 74 63 6c 74 65 n "$msg $::tclte
15f0: 73 74 3a 3a 74 63 6c 74 65 73 74 22 0a 09 09 73 st::tcltest"...s
1600: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
1610: 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 20 20 moteServer 0..
1620: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 20 65 6c 73 }..}. } els
1630: 65 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 e {..fconfigure
1640: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d $commandSocket -
1650: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
1660: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
1670: 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 53 6f 6d 65 . }.}..# Some
1680: 20 74 65 73 74 73 20 61 72 65 20 72 75 6e 20 6f tests are run o
1690: 6e 6c 79 20 69 66 20 77 65 20 61 72 65 20 64 6f nly if we are do
16a0: 69 6e 67 20 74 65 73 74 69 6e 67 20 61 67 61 69 ing testing agai
16b0: 6e 73 74 20 61 20 72 65 6d 6f 74 65 20 73 65 72 nst a remote ser
16c0: 76 65 72 2e 0a 73 65 74 20 3a 3a 74 63 6c 74 65 ver..set ::tclte
16d0: 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 st::testConstrai
16e0: 6e 74 73 28 64 6f 54 65 73 74 73 57 69 74 68 52 nts(doTestsWithR
16f0: 65 6d 6f 74 65 53 65 72 76 65 72 29 20 24 64 6f emoteServer) $do
1700: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1710: 65 72 76 65 72 0a 69 66 20 7b 24 64 6f 54 65 73 erver.if {$doTes
1720: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
1730: 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 20 69 er == 0} {. i
1740: 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 74 f {[string first
1750: 20 73 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 76 s $::tcltest::v
1760: 65 72 62 6f 73 65 5d 20 21 3d 20 2d 31 7d 20 7b erbose] != -1} {
1770: 0a 20 20 20 20 09 70 75 74 73 20 22 53 6b 69 70 . .puts "Skip
1780: 70 69 6e 67 20 74 65 73 74 73 20 77 69 74 68 20 ping tests with
1790: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 20 53 remote server. S
17a0: 65 65 20 74 65 73 74 73 2f 73 6f 63 6b 65 74 2e ee tests/socket.
17b0: 74 65 73 74 20 66 6f 72 22 0a 09 70 75 74 73 20 test for"..puts
17c0: 22 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 "information on
17d0: 68 6f 77 20 74 6f 20 72 75 6e 20 72 65 6d 6f 74 how to run remot
17e0: 65 20 73 65 72 76 65 72 2e 22 0a 09 70 75 74 73 e server."..puts
17f0: 20 22 52 65 61 73 6f 6e 20 66 6f 72 20 6e 6f 74 "Reason for not
1800: 20 64 6f 69 6e 67 20 72 65 6d 6f 74 65 20 74 65 doing remote te
1810: 73 74 73 3a 20 24 6e 6f 52 65 6d 6f 74 65 54 65 sts: $noRemoteTe
1820: 73 74 52 65 61 73 6f 6e 22 0a 20 20 20 20 7d 0a stReason". }.
1830: 7d 0a 0a 23 0a 23 20 49 66 20 77 65 20 64 6f 20 }..#.# If we do
1840: 74 68 65 20 74 65 73 74 73 2c 20 64 65 66 69 6e the tests, defin
1850: 65 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 73 e a command to s
1860: 65 6e 64 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f end a command to
1870: 20 74 68 65 0a 23 20 72 65 6d 6f 74 65 20 73 65 the.# remote se
1880: 72 76 65 72 2e 0a 23 0a 0a 69 66 20 7b 24 64 6f rver..#..if {$do
1890: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
18a0: 65 72 76 65 72 20 3d 3d 20 31 7d 20 7b 0a 20 20 erver == 1} {.
18b0: 20 20 70 72 6f 63 20 73 65 6e 64 43 6f 6d 6d 61 proc sendComma
18c0: 6e 64 20 7b 63 7d 20 7b 0a 09 67 6c 6f 62 61 6c nd {c} {..global
18d0: 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 0a commandSocket..
18e0: 09 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 .if {[eof $comma
18f0: 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 20 20 ndSocket]} {..
1900: 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 error "remote
1910: 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 server disappear
1920: 65 64 22 0a 09 7d 0a 0a 09 69 66 20 7b 5b 63 61 ed"..}...if {[ca
1930: 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 tch {puts $comma
1940: 6e 64 53 6f 63 6b 65 74 20 24 63 7d 20 6d 73 67 ndSocket $c} msg
1950: 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 ]} {.. error
1960: 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 "remote server d
1970: 69 73 61 70 70 61 65 72 65 64 3a 20 24 6d 73 67 isappaered: $msg
1980: 22 0a 09 7d 0a 09 69 66 20 7b 5b 63 61 74 63 68 "..}..if {[catch
1990: 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 {puts $commandS
19a0: 6f 63 6b 65 74 20 22 2d 2d 4d 61 72 6b 65 72 2d ocket "--Marker-
19b0: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
19c0: 2d 22 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 -"} msg]} {..
19d0: 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 error "remote s
19e0: 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 65 erver disappeare
19f0: 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 0a 09 73 65 d: $msg"..}...se
1a00: 74 20 72 65 73 70 20 22 22 0a 09 77 68 69 6c 65 t resp ""..while
1a10: 20 7b 31 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 {1} {.. set
1a20: 6c 69 6e 65 20 5b 67 65 74 73 20 24 63 6f 6d 6d line [gets $comm
1a30: 61 6e 64 53 6f 63 6b 65 74 5d 0a 09 20 20 20 20 andSocket]..
1a40: 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d 61 6e if {[eof $comman
1a50: 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 09 65 72 dSocket]} {...er
1a60: 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 ror "remote serv
1a70: 65 72 20 64 69 73 61 70 70 61 65 72 65 64 22 0a er disappaered".
1a80: 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 20 7b . }.. if {
1a90: 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 [string compare
1aa0: 24 6c 69 6e 65 20 22 2d 2d 4d 61 72 6b 65 72 2d $line "--Marker-
1ab0: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1ac0: 2d 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 69 66 -"] == 0} {...if
1ad0: 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 {[string compar
1ae0: 65 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 e [lindex $resp
1af0: 30 5d 20 65 72 72 6f 72 5d 20 3d 3d 20 30 7d 20 0] error] == 0}
1b00: 7b 0a 09 09 20 20 20 20 65 72 72 6f 72 20 5b 6c {... error [l
1b10: 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 index $resp 1]..
1b20: 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 .} else {...
1b30: 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 78 20 24 return [lindex $
1b40: 72 65 73 70 20 31 5d 0a 09 09 7d 0a 09 20 20 20 resp 1]...}..
1b50: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 61 70 70 65 } else {...appe
1b60: 6e 64 20 72 65 73 70 20 24 6c 69 6e 65 20 22 5c nd resp $line "\
1b70: 6e 22 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 n".. }..}.
1b80: 20 7d 0a 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 }.}..test socke
1b90: 74 2d 31 2e 31 20 7b 61 72 67 20 70 61 72 73 69 t-1.1 {arg parsi
1ba0: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1bb0: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1bc0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1bd0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1be0: 73 65 72 76 65 72 7d 20 6d 73 67 5d 20 24 6d 73 server} msg] $ms
1bf0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
1c00: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
1c10: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
1c20: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
1c30: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
1c40: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 32 20 test socket-1.2
1c50: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
1c60: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
1c70: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
1c80: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
1c90: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
1ca0: 20 66 6f 6f 7d 20 6d 73 67 5d 20 24 6d 73 67 0a foo} msg] $msg.
1cb0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
1cc0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
1cd0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
1ce0: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 er command ?opti
1cf0: 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 ons? port"}}..te
1d00: 73 74 20 73 6f 63 6b 65 74 2d 31 2e 33 20 7b 61 st socket-1.3 {a
1d10: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
1d20: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
1d30: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
1d40: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
1d50: 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 7d 20 socket -myaddr}
1d60: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
1d70: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
1d80: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
1d90: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
1da0: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
1db0: 74 20 73 6f 63 6b 65 74 2d 31 2e 34 20 7b 61 72 t socket-1.4 {ar
1dc0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1dd0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1de0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1df0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1e00: 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 32 ocket -myaddr 12
1e10: 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 5d 20 24 6d 7.0.0.1} msg] $m
1e20: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
1e30: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
1e40: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f "tls::socket ?o
1e50: 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 ptions? host por
1e60: 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 t"}}..test socke
1e70: 74 2d 31 2e 35 20 7b 61 72 67 20 70 61 72 73 69 t-1.5 {arg parsi
1e80: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1e90: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1ea0: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1eb0: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1ec0: 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 myport} msg] $ms
1ed0: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
1ee0: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
1ef0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
1f00: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
1f10: 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 "}}..test socket
1f20: 2d 31 2e 36 20 7b 61 72 67 20 70 61 72 73 69 6e -1.6 {arg parsin
1f30: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
1f40: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
1f50: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
1f60: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
1f70: 79 70 6f 72 74 20 78 78 78 78 7d 20 6d 73 67 5d yport xxxx} msg]
1f80: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
1f90: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
1fa0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
1fb0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
1fc0: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f port"}}..test so
1fd0: 63 6b 65 74 2d 31 2e 37 20 7b 61 72 67 20 70 61 cket-1.7 {arg pa
1fe0: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
1ff0: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2000: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2010: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2020: 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 32 7d 20 t -myport 2522}
2030: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
2040: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
2050: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
2060: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
2070: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
2080: 74 20 73 6f 63 6b 65 74 2d 31 2e 38 20 7b 61 72 t socket-1.8 {ar
2090: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
20a0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
20b0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
20c0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
20d0: 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a 7d 20 6d ocket -froboz} m
20e0: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
20f0: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2100: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2110: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
2120: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
2130: 20 73 6f 63 6b 65 74 2d 31 2e 39 20 7b 61 72 67 socket-1.9 {arg
2140: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2150: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2160: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2170: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2180: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f cket -server foo
2190: 20 2d 6d 79 70 6f 72 74 20 32 35 32 31 20 33 33 -myport 2521 33
21a0: 33 33 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 33} msg] $msg.}
21b0: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
21c0: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
21d0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
21e0: 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e command ?option
21f0: 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 s? port"}}..test
2200: 20 73 6f 63 6b 65 74 2d 31 2e 31 30 20 7b 61 72 socket-1.10 {ar
2210: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
2220: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
2230: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
2240: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2250: 6f 63 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 ocket host 2528
2260: 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 -junk} msg] $msg
2270: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
2280: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
2290: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
22a0: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
22b0: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
22c0: 31 2e 31 31 20 7b 61 72 67 20 70 61 72 73 69 6e 1.11 {arg parsin
22d0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
22e0: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
22f0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
2300: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
2310: 65 72 76 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 erver callback 2
2320: 35 32 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 520 --} msg] $ms
2330: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
2340: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
2350: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
2360: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
2370: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
2380: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 31 32 test socket-1.12
2390: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
23a0: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
23b0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
23c0: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
23d0: 73 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f 20 62 61 s::socket foo ba
23e0: 64 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 dport} msg] $msg
23f0: 0a 7d 20 7b 31 20 7b 65 78 70 65 63 74 65 64 20 .} {1 {expected
2400: 69 6e 74 65 67 65 72 20 62 75 74 20 67 6f 74 20 integer but got
2410: 22 62 61 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 "badport"}}..tes
2420: 74 20 73 6f 63 6b 65 74 2d 32 2e 31 20 7b 74 63 t socket-2.1 {tc
2430: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 p connection} {s
2440: 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 ocket stdio pcCr
2450: 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ash} {. remov
2460: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
2470: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
2480: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
2490: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
24a0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
24b0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
24c0: 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 2000 "set x time
24d0: 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 5b d_out"]..set f [
24e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
24f0: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d ver accept 2828]
2500: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 ..proc accept {f
2510: 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b ile addr port} {
2520: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
2530: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
2540: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
2550: 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 $file..}..puts
2560: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
2570: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
2580: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 mer..close $f..p
2590: 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 uts $x. }.
25a0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
25b0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
25c0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
25d0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
25e0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
25f0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
2600: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
2610: 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 5d 0.0.1 2828} msg]
2620: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
2630: 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 x $msg. } els
2640: 65 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 e {. lapp
2650: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
2660: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d close $m
2670: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 sg. }. lap
2680: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
2690: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
26a0: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
26b0: 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 done {}}..if [i
26c0: 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d nfo exists port]
26d0: 20 7b 0a 20 20 20 20 69 6e 63 72 20 70 6f 72 74 {. incr port
26e0: 0a 7d 20 65 6c 73 65 20 7b 20 0a 20 20 20 20 73 .} else { . s
26f0: 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 32 30 et port [expr 20
2700: 34 38 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 48 + [pid]%1024]
2710: 0a 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d .}..test socket-
2720: 32 2e 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.2 {tcp connect
2730: 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 ion with client
2740: 70 6f 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 port specified}
2750: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
2760: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
2770: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
2780: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
2790: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
27a0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
27b0: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
27c0: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
27d0: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 x done"]. }.
27e0: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
27f0: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
2800: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
2810: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
2820: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
2830: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
2840: 65 72 76 65 72 4b 65 79 20 32 38 32 39 20 5c 5d erverKey 2829 \]
2850: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
2860: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
2870: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
2880: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
2890: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
28a0: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 puts "[gets $fi
28b0: 6c 65 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 20 le] $port".
28c0: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 close $fi
28d0: 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 le. s
28e0: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
28f0: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
2900: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
2910: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
2920: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
2930: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
2940: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
2950: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
2960: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
2970: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 67 6c gets $f x. gl
2980: 6f 62 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 obal port. if
2990: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
29a0: 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 ocket -myport $p
29b0: 6f 72 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ort \..-certfile
29c0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
29d0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
29e0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
29f0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 Key 127.0.0.1 28
2a00: 32 39 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 29} sock]} {.
2a10: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
2a20: 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b ..catch {close [
2a30: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
2a40: 30 2e 30 2e 31 20 32 38 32 39 5d 7d 0a 20 20 20 0.0.1 2829]}.
2a50: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
2a60: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
2a70: 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a lo..flush $sock.
2a80: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
2a90: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
2aa0: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
2ab0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
2ac0: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 5b $f. set x.} [
2ad0: 6c 69 73 74 20 72 65 61 64 79 20 22 68 65 6c 6c list ready "hell
2ae0: 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 o $port"]..test
2af0: 73 6f 63 6b 65 74 2d 32 2e 33 20 7b 74 63 70 20 socket-2.3 {tcp
2b00: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
2b10: 63 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 63 65 client interface
2b20: 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 specified} {soc
2b30: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
2b40: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
2b50: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
2b60: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
2b70: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
2b80: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
2b90: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
2ba0: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f r 2000 "set x do
2bb0: 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ne"]. }. p
2bc0: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
2bd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
2be0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
2bf0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
2c00: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
2c10: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
2c20: 72 4b 65 79 20 32 38 33 30 20 5c 5d 22 0a 20 20 rKey 2830 \]".
2c30: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
2c40: 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 c accept {file a
2c50: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 ddr port} {.
2c60: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
2c70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
2c80: 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 20 s "[gets $file]
2c90: 24 61 64 64 72 22 0a 20 20 20 20 20 20 20 20 20 $addr".
2ca0: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 close $file.
2cb0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
2cc0: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
2cd0: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
2ce0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
2cf0: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 er..close $f.
2d00: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
2d10: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
2d20: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
2d30: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
2d40: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
2d50: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
2d60: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2d70: 74 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e t -myaddr 127.0.
2d80: 30 2e 31 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 0.1 \..-certfile
2d90: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
2da0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
2db0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
2dc0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 Key 127.0.0.1 28
2dd0: 33 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 30} sock]} {.
2de0: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
2df0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
2e00: 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b puts $sock
2e10: 20 68 65 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 hello..catch {f
2e20: 6c 75 73 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 lush $sock}.
2e30: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
2e40: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
2e50: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
2e60: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
2e70: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
2e80: 79 20 7b 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 y {hello 127.0.0
2e90: 2e 31 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 .1}}..test socke
2ea0: 74 2d 32 2e 34 20 7b 74 63 70 20 63 6f 6e 6e 65 t-2.4 {tcp conne
2eb0: 63 74 69 6f 6e 20 77 69 74 68 20 73 65 72 76 65 ction with serve
2ec0: 72 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 r interface spec
2ed0: 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 ified} {socket s
2ee0: 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a tdio pcCrash} {.
2ef0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
2f00: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
2f10: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
2f20: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
2f30: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
2f40: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
2f50: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
2f60: 20 64 6f 6e 65 22 5d 0a 20 20 20 20 20 20 20 20 done"].
2f70: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
2f80: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
2f90: 74 20 2d 6d 79 61 64 64 72 20 5b 69 6e 66 6f 20 t -myaddr [info
2fa0: 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 5d 0a hostname] 2831].
2fb0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
2fc0: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
2fd0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
2fe0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
2ff0: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 puts "[gets $fi
3000: 6c 65 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 le]".
3010: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 close $file.
3020: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
3030: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
3040: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3050: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3060: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
3070: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3080: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3090: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
30a0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
30b0: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
30c0: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
30d0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
30e0: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
30f0: 32 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 2831} sock]} {.
3100: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f set x $so
3110: 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ck. } else {.
3120: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
3130: 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 ck hello..flush
3140: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 $sock. la
3150: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
3160: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
3170: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
3180: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3190: 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c x.} {ready hell
31a0: 6f 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 o}.test socket-2
31b0: 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .5 {tcp connecti
31c0: 6f 6e 20 77 69 74 68 20 72 65 64 75 6e 64 61 6e on with redundan
31d0: 74 20 73 65 72 76 65 72 20 70 6f 72 74 7d 20 7b t server port} {
31e0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 socket stdio pcC
31f0: 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rash} {. remo
3200: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
3210: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
3220: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
3230: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
3240: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
3250: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
3260: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
3270: 20 20 20 20 20 20 20 20 73 65 74 20 66 20 5b 74 set f [t
3280: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
3290: 65 72 20 61 63 63 65 70 74 20 32 38 33 32 5d 0a er accept 2832].
32a0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
32b0: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
32c0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
32d0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
32e0: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 puts "[gets $fi
32f0: 6c 65 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 le]".
3300: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 close $file.
3310: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
3320: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
3330: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3340: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3350: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
3360: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3370: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3380: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3390: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
33a0: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
33b0: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
33c0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
33d0: 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 32 7d 20 127.0.0.1 2832}
33e0: 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 sock]} {.
33f0: 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 set x $sock.
3400: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
3410: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
3420: 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a lo..flush $sock.
3430: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
3440: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
3450: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
3460: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
3470: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
3480: 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 ready hello}.tes
3490: 74 20 73 6f 63 6b 65 74 2d 32 2e 36 20 7b 74 63 t socket-2.6 {tc
34a0: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 p connection} {s
34b0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
34c0: 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 status ok. i
34d0: 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 f {![catch {set
34e0: 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 sock [tls::socke
34f0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 33 t 127.0.0.1 2833
3500: 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 ]}]} {..if {![ca
3510: 74 63 68 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d tch {gets $sock}
3520: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 ]} {.. set st
3530: 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 atus broken..}..
3540: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3550: 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 }. set status
3560: 0a 7d 20 6f 6b 0a 74 65 73 74 20 73 6f 63 6b 65 .} ok.test socke
3570: 74 2d 32 2e 37 20 7b 65 63 68 6f 20 73 65 72 76 t-2.7 {echo serv
3580: 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 er, one line} {s
3590: 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 ocket stdio pcCr
35a0: 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ash} {. remov
35b0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
35c0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
35d0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
35e0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
35f0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
3600: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
3610: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 "set x done"]..
3620: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
3630: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3640: 74 20 32 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 t 2834]..proc ac
3650: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 cept {s a p} {.
3660: 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 filee
3670: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
3680: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
3690: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
36a0: 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $s -translation
36b0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
36c0: 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 ne. }..pr
36d0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
36e0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
36f0: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
3700: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
3710: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3720: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
3730: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
3740: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
3750: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
3760: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 . }
3770: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 else {.
3780: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
3790: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
37a0: 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 }..}..puts ready
37b0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
37c0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
37d0: 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 64 close $f..puts d
37e0: 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c one. }. cl
37f0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
3800: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
3810: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
3820: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
3830: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
3840: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
3850: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 34 t 127.0.0.1 2834
3860: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
3870: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
3880: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
3890: 20 6c 66 0a 20 20 20 20 70 75 74 73 20 24 73 20 lf. puts $s
38a0: 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 "hello abcdefghi
38b0: 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 66 74 jklmnop". aft
38c0: 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 er 1000. set
38d0: 78 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 x [gets $s].
38e0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 close $s. set
38f0: 20 79 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 y [gets $f].
3900: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 6c 69 close $f. li
3910: 73 74 20 24 78 20 24 79 0a 7d 20 7b 7b 68 65 6c st $x $y.} {{hel
3920: 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d lo abcdefghijklm
3930: 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 nop} done}..test
3940: 20 73 6f 63 6b 65 74 2d 32 2e 38 20 7b 65 63 68 socket-2.8 {ech
3950: 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f 70 20 35 o server, loop 5
3960: 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 6c 65 20 0 times, single
3970: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
3980: 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 ket stdio pcCras
3990: 68 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c h} {. makeFil
39a0: 65 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 e {. .package
39b0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
39c0: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
39d0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
39e0: 32 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 2835]..proc acce
39f0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 pt {s a p} {.
3a00: 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 fileeve
3a10: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
3a20: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 list echo $s].
3a30: 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 fconfi
3a40: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
3a50: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 ng line.
3a60: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
3a70: 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 {.. global
3a80: 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 i. 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 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 { .. inc
3b30: 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 r i.
3b40: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a puts $s $l.
3b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 }..
3b60: 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 75 74 73 }..set i 0..puts
3b70: 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 ready..set time
3b80: 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 r [after 20000 "
3b90: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 76 77 set x done"]..vw
3ba0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
3bb0: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
3bc0: 65 20 24 66 0a 09 70 75 74 73 20 22 64 6f 6e 65 e $f..puts "done
3bd0: 20 24 69 22 0a 20 20 20 20 7d 20 73 63 72 69 70 $i". } scrip
3be0: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
3bf0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3c00: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3c10: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
3c20: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 ts $f. set s
3c30: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
3c40: 2e 30 2e 30 2e 31 20 32 38 33 35 5d 0a 20 20 20 .0.0.1 2835].
3c50: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
3c60: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
3c70: 20 20 20 63 61 74 63 68 20 7b 0a 09 66 6f 72 20 catch {..for
3c80: 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 20 3c 20 {set x 0} {$x <
3c90: 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 50} {incr x} {..
3ca0: 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 6c puts $s "hel
3cb0: 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d lo abcdefghijklm
3cc0: 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 73 20 24 nop".. gets $
3cd0: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 s..}. }. c
3ce0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 61 74 63 lose $s. catc
3cf0: 68 20 7b 73 65 74 20 78 20 5b 67 65 74 73 20 24 h {set x [gets $
3d00: 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 f]}. close $f
3d10: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 64 6f . set x.} {do
3d20: 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 73 6f 63 ne 50}..test soc
3d30: 6b 65 74 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 20 ket-2.9 {socket
3d40: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
3d50: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 t stdio} {. s
3d60: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
3d70: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3d80: 20 32 38 32 38 5d 0a 20 20 20 20 72 65 6d 6f 76 2828]. remov
3d90: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
3da0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
3db0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
3dc0: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 7b 70 -nonewline $f {p
3dd0: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
3de0: 6c 73 3b 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ls; tls::socket
3df0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
3e00: 38 32 38 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 828}. close $
3e10: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
3e20: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3e30: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3e40: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
3e50: 74 73 20 24 66 0a 20 20 20 20 61 66 74 65 72 20 ts $f. after
3e60: 31 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 100. set x [l
3e70: 69 73 74 20 5b 63 61 74 63 68 20 7b 63 6c 6f 73 ist [catch {clos
3e80: 65 20 24 66 7d 20 6d 73 67 5d 20 24 6d 73 67 5d e $f} msg] $msg]
3e90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
3ea0: 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f set x.} {1 {co
3eb0: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
3ec0: 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 et: address alre
3ed0: 61 64 79 20 69 6e 20 75 73 65 0a 20 20 20 20 77 ady in use. w
3ee0: 68 69 6c 65 20 65 78 65 63 75 74 69 6e 67 0a 22 hile executing."
3ef0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
3f00: 20 7b 74 6c 73 3a 3a 5f 61 63 63 65 70 74 20 7b {tls::_accept {
3f10: 2d 73 65 72 76 65 72 20 31 7d 20 61 63 63 65 70 -server 1} accep
3f20: 74 7d 20 32 38 32 38 22 0a 20 20 20 20 28 22 65 t} 2828". ("e
3f30: 76 61 6c 22 20 62 6f 64 79 20 6c 69 6e 65 20 31 val" body line 1
3f40: 29 0a 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 ). invoked fr
3f50: 6f 6d 20 77 69 74 68 69 6e 0a 22 65 76 61 6c 20 om within."eval
3f60: 3a 3a 73 6f 63 6b 65 74 20 24 73 6f 70 74 73 22 ::socket $sopts"
3f70: 0a 20 20 20 20 28 70 72 6f 63 65 64 75 72 65 20 . (procedure
3f80: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 22 20 6c 69 "tls::socket" li
3f90: 6e 65 20 36 32 29 0a 20 20 20 20 69 6e 76 6f 6b ne 62). invok
3fa0: 65 64 20 66 72 6f 6d 20 77 69 74 68 69 6e 0a 22 ed from within."
3fb0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3fc0: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 22 ver accept 2828"
3fd0: 0a 20 20 20 20 28 66 69 6c 65 20 22 73 63 72 69 . (file "scri
3fe0: 70 74 22 20 6c 69 6e 65 20 31 29 7d 7d 0a 0a 74 pt" line 1)}}..t
3ff0: 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 31 30 20 est socket-2.10
4000: 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 63 65 70 74 {close on accept
4010: 2c 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 , accepted socke
4020: 74 20 6c 69 76 65 73 7d 20 7b 73 6f 63 6b 65 74 t lives} {socket
4030: 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 pcCrash} {.
4040: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 set done 0. s
4050: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
4060: 32 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 20000 "set done
4070: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
4080: 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 set ss [tls::soc
4090: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
40a0: 70 74 20 32 38 33 30 5d 0a 20 20 20 20 70 72 6f pt 2830]. pro
40b0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
40c0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 {..global ss..c
40d0: 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 65 76 lose $ss..fileev
40e0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
40f0: 22 72 65 61 64 69 74 20 24 73 22 0a 09 66 63 6f "readit $s"..fco
4100: 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e nfigure $s -tran
4110: 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 s lf. }. p
4120: 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b roc readit {s} {
4130: 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 ..global done..g
4140: 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 ets $s..close $s
4150: 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 ..set done 1.
4160: 20 7d 0a 20 20 20 20 73 65 74 20 63 73 20 5b 74 }. set cs [t
4170: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f ls::socket [info
4180: 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d hostname] 2830]
4190: 0a 20 20 20 20 70 75 74 73 20 24 63 73 20 68 65 . puts $cs he
41a0: 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 llo. close $c
41b0: 73 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 s. vwait done
41c0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
41d0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 l $timer. set
41e0: 20 64 6f 6e 65 0a 7d 20 31 0a 74 65 73 74 20 73 done.} 1.test s
41f0: 6f 63 6b 65 74 2d 32 2e 31 31 20 7b 64 65 74 65 ocket-2.11 {dete
4200: 63 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 cting new data}
4210: 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d {socket pcCrash}
4220: 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 {. proc acce
4230: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
4240: 6f 62 61 6c 20 73 6f 63 6b 0a 09 73 65 74 20 73 obal sock..set s
4250: 6f 63 6b 20 24 73 0a 20 20 20 20 7d 0a 0a 20 20 ock $s. }..
4260: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
4270: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4280: 65 70 74 20 32 34 30 30 5d 0a 20 20 20 20 73 65 ept 2400]. se
4290: 74 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 65 t sock "". se
42a0: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
42b0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 34 30 30 t 127.0.0.1 2400
42c0: 5d 0a 20 20 20 20 76 77 61 69 74 20 73 6f 63 6b ]. vwait sock
42d0: 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 6f 6e . puts $s2 on
42e0: 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a e. flush $s2.
42f0: 20 20 20 20 61 66 74 65 72 20 35 30 30 0a 20 20 after 500.
4300: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
4310: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 ck -blocking 0.
4320: 20 20 20 73 65 74 20 72 65 73 75 6c 74 20 5b 67 set result [g
4330: 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 6c ets $sock]. l
4340: 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 67 append result [g
4350: 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 ets $sock]. f
4360: 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 configure $sock
4370: 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 -blocking 1.
4380: 70 75 74 73 20 24 73 32 20 74 77 6f 0a 20 20 20 puts $s2 two.
4390: 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 66 flush $s2. f
43a0: 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 configure $sock
43b0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 -blocking 0.
43c0: 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b lappend result [
43d0: 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 gets $sock].
43e0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
43f0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 -blocking 1.
4400: 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 close $s2. c
4410: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
4420: 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 20 e $sock. set
4430: 72 65 73 75 6c 74 0a 7d 20 7b 6f 6e 65 20 7b 7d result.} {one {}
4440: 20 74 77 6f 7d 0a 0a 0a 74 65 73 74 20 73 6f 63 two}...test soc
4450: 6b 65 74 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 ket-3.1 {socket
4460: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
4470: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
4480: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
4490: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
44a0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
44b0: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
44c0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
44d0: 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 s..set f [tls::s
44e0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
44f0: 63 65 70 74 20 32 38 32 38 5d 0a 09 70 75 74 73 cept 2828]..puts
4500: 20 72 65 61 64 79 0a 09 67 65 74 73 20 73 74 64 ready..gets std
4510: 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 in..close $f.
4520: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
4530: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
4540: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
4550: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
4560: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 67 65 74 pt]" r+]. get
4570: 73 20 24 66 0a 20 20 20 20 73 65 74 20 78 20 5b s $f. set x [
4580: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
4590: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
45a0: 20 61 63 63 65 70 74 20 32 38 32 38 7d 20 6d 73 accept 2828} ms
45b0: 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 g] \...$msg].
45c0: 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 puts $f bye.
45d0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
45e0: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
45f0: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
4600: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
4610: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 73 in use}}..test s
4620: 6f 63 6b 65 74 2d 33 2e 32 20 7b 73 65 72 76 65 ocket-3.2 {serve
4630: 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 r with several c
4640: 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 lients} {socket
4650: 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b stdio pcCrash} {
4660: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
4670: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
4680: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
4690: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 . puts $f {.
46a0: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
46b0: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 31 20 ire tls..set t1
46c0: 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 [after 30000 "se
46d0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
46e0: 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 .set t2 [after 3
46f0: 31 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 1000 "set x time
4700: 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 33 20 d_out"]..set t3
4710: 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 73 65 [after 32000 "se
4720: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
4730: 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 09 .set counter 0..
4740: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
4750: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
4760: 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 t 2828]..proc ac
4770: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
4780: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
4790: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
47a0: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
47b0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
47c0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 fering line..}..
47d0: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
47e0: 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 . global x.
47f0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
4800: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
4810: 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f if {[eo
4820: 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 f $s]} {.
4830: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
4840: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
4850: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
4860: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
4870: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 se {.
4880: 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c puts $s $l
4890: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a . }.
48a0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
48b0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
48c0: 61 6e 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 ancel $t1..vwait
48d0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
48e0: 20 24 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 $t2..vwait x..a
48f0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a fter cancel $t3.
4900: 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 .close $s..puts
4910: 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $x. }. clo
4920: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
4930: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
4940: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
4950: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
4960: 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 set x [gets $
4970: 66 5d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 f]. set s1 [t
4980: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
4990: 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 66 .0.1 2828]. f
49a0: 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 configure $s1 -b
49b0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
49c0: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
49d0: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
49e0: 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2828]. fconfi
49f0: 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 gure $s2 -buffer
4a00: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
4a10: 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s3 [tls::socket
4a20: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 127.0.0.1 2828]
4a30: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4a40: 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s3 -buffering l
4a50: 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 ine. for {set
4a60: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d i 0} {$i < 100}
4a70: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 {incr i} {..put
4a80: 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 s $s1 hello,s1..
4a90: 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 gets $s1..puts $
4aa0: 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 s2 hello,s2..get
4ab0: 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 s $s2..puts $s3
4ac0: 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 hello,s3..gets $
4ad0: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f s3. }. clo
4ae0: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 se $s1. close
4af0: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
4b00: 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 s3. lappend x
4b10: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
4b20: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4b30: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d x.} {ready done}
4b40: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 34 2e ..test socket-4.
4b50: 31 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 1 {server with s
4b60: 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 everal clients}
4b70: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 {socket stdio pc
4b80: 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d Crash} {. rem
4b90: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
4ba0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
4bb0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
4bc0: 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b s $f {. .pack
4bd0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
4be0: 09 67 65 74 73 20 73 74 64 69 6e 0a 09 73 65 74 .gets stdin..set
4bf0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
4c00: 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 127.0.0.1 2828].
4c10: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
4c20: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
4c30: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
4c40: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
4c50: 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 } {.. puts $s
4c60: 20 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 hello.. gets
4c70: 20 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 $s..}..close $s
4c80: 0a 09 70 75 74 73 20 62 79 65 0a 09 67 65 74 73 ..puts bye..gets
4c90: 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 stdin. }.
4ca0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4cb0: 74 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 t p1 [open "|[li
4cc0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
4cd0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
4ce0: 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 r+]. fconfigu
4cf0: 72 65 20 24 70 31 20 2d 62 75 66 66 65 72 69 6e re $p1 -bufferin
4d00: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 g line. set p
4d10: 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 2 [open "|[list
4d20: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
4d30: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
4d40: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4d50: 24 70 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $p2 -buffering l
4d60: 69 6e 65 0a 20 20 20 20 73 65 74 20 70 33 20 5b ine. set p3 [
4d70: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
4d80: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
4d90: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
4da0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 33 fconfigure $p3
4db0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
4dc0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
4dd0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
4de0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
4df0: 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 ring line..filee
4e00: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
4e10: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
4e20: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 }. proc e
4e30: 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 cho {s} {..globa
4e40: 6c 20 78 0a 20 20 20 20 20 20 20 20 73 65 74 20 l x. set
4e50: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
4e60: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
4e70: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
4e80: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
4e90: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
4ea0: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
4eb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
4ec0: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
4ed0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
4ee0: 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 t1 [after 30000
4ef0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
4f00: 22 5d 0a 20 20 20 20 73 65 74 20 74 32 20 5b 61 "]. set t2 [a
4f10: 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 20 fter 31000 "set
4f20: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
4f30: 20 20 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 set t3 [after
4f40: 33 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 32000 "set x tim
4f50: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 ed_out"]. set
4f60: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
4f70: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
4f80: 38 32 38 5d 0a 20 20 20 20 70 75 74 73 20 24 70 828]. puts $p
4f90: 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 1 open. puts
4fa0: 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 $p2 open. put
4fb0: 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 20 76 s $p3 open. v
4fc0: 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 wait x. vwait
4fd0: 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 x. vwait x.
4fe0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
4ff0: 24 74 31 0a 20 20 20 20 61 66 74 65 72 20 63 61 $t1. after ca
5000: 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 61 66 74 ncel $t2. aft
5010: 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 20 20 er cancel $t3.
5020: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
5030: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
5040: 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 20 5b end l [list p1 [
5050: 67 65 74 73 20 24 70 31 5d 20 24 78 5d 0a 20 20 gets $p1] $x].
5060: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
5070: 74 20 70 32 20 5b 67 65 74 73 20 24 70 32 5d 20 t p2 [gets $p2]
5080: 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $x]. lappend
5090: 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 74 73 l [list p3 [gets
50a0: 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 70 75 $p3] $x]. pu
50b0: 74 73 20 24 70 31 20 62 79 65 0a 20 20 20 20 70 ts $p1 bye. p
50c0: 75 74 73 20 24 70 32 20 62 79 65 0a 20 20 20 20 uts $p2 bye.
50d0: 70 75 74 73 20 24 70 33 20 62 79 65 0a 20 20 20 puts $p3 bye.
50e0: 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 20 63 close $p1. c
50f0: 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 63 6c 6f lose $p2. clo
5100: 73 65 20 24 70 33 0a 20 20 20 20 73 65 74 20 6c se $p3. set l
5110: 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 6f 6e 65 .} {{p1 bye done
5120: 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e 65 7d 20 } {p2 bye done}
5130: 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a {p3 bye done}}..
5140: 74 65 73 74 20 73 6f 63 6b 65 74 2d 34 2e 32 20 test socket-4.2
5150: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
5160: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
5170: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f bers, htons} {so
5180: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
5190: 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b 63 61 x ok. if {[ca
51a0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
51b0: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 -server dodo 0x
51c0: 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 3000} msg]} {..s
51d0: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
51e0: 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d else {..close $m
51f0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
5200: 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 73 6f x.} ok..test so
5210: 63 6b 65 74 2d 35 2e 31 20 7b 62 79 74 65 20 6f cket-5.1 {byte o
5220: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
5230: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
5240: 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 tons} \..{socket
5250: 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f unixOnly notRoo
5260: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b t} {. set x {
5270: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
5280: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
5290: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
52a0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
52b0: 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 7d 20 erver dodo 0x1}
52c0: 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 msg]} {.
52d0: 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f set x {htons pro
52e0: 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 blem, should be
52f0: 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 disallowed, are
5300: 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 you running as S
5310: 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a U?}..close $msg.
5320: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a }. set x.
5330: 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e } {couldn't open
5340: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
5350: 65 72 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d er}.test socket-
5360: 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.2 {byte order
5370: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
5380: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
5390: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
53a0: 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 set x {couldn't
53b0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 open socket: por
53c0: 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 t number too hig
53d0: 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 h}. if {![cat
53e0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
53f0: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 -server dodo 0x1
5400: 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 0000} msg]} {..s
5410: 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c et x {port resol
5420: 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 ution problem, s
5430: 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f hould be disallo
5440: 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 wed}..close $msg
5450: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
5460: 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 .} {couldn't ope
5470: 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e n socket: port n
5480: 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a umber too high}.
5490: 74 65 73 74 20 73 6f 63 6b 65 74 2d 35 2e 33 20 test socket-5.3
54a0: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
54b0: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
54c0: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 bers, htons} \..
54d0: 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 {socket unixOnly
54e0: 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 notRoot} {.
54f0: 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 set x {couldn't
5500: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 open socket: not
5510: 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b owner}. if {
5520: 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f ![catch {tls::so
5530: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
5540: 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 o 21} msg]} {..s
5550: 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 et x {htons prob
5560: 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 lem, should be d
5570: 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 isallowed, are y
5580: 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 ou running as SU
5590: 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 ?}..close $msg.
55a0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
55b0: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
55c0: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
55d0: 72 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d r}..test socket-
55e0: 36 2e 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 6.1 {accept call
55f0: 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 back error} {soc
5600: 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 ket stdio pcCras
5610: 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 h} {. removeF
5620: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
5630: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
5640: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
5650: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
5660: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 require tls..get
5670: 73 20 73 74 64 69 6e 0a 09 74 6c 73 3a 3a 73 6f s stdin..tls::so
5680: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
5690: 38 34 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 848. }. cl
56a0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
56b0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
56c0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
56d0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
56e0: 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 proc bgerror
56f0: 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 args {..global
5700: 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 x..set x $args.
5710: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 }. proc ac
5720: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 cept {s a p} {ex
5730: 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 pr 10 / 0}. s
5740: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
5750: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
5760: 20 32 38 34 38 5d 0a 20 20 20 20 70 75 74 73 20 2848]. puts
5770: 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f $f hello. clo
5780: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 74 69 se $f. set ti
5790: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
57a0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
57b0: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
57c0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
57d0: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
57e0: 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 e $s. rename
57f0: 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 bgerror {}. s
5800: 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 et x.} {{divide
5810: 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 by zero}}..test
5820: 73 6f 63 6b 65 74 2d 37 2e 31 20 7b 74 65 73 74 socket-7.1 {test
5830: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
5840: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
5850: 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 cket stdio pcCra
5860: 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 sh} {. remove
5870: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
5880: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
5890: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
58a0: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
58b0: 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 uire tls..tls::s
58c0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
58d0: 63 65 70 74 20 32 38 32 30 0a 09 70 72 6f 63 20 cept 2820..proc
58e0: 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 accept args {..
58f0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
5900: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
5910: 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 puts ready..set
5920: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
5930: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5940: 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 out"]..vwait x..
5950: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
5960: 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c mer. }. cl
5970: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
5980: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5990: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
59a0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
59b0: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
59c0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
59d0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 30 t 127.0.0.1 2820
59e0: 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f ]. set p [fco
59f0: 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 nfigure $s -peer
5a00: 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 name]. close
5a10: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a $s. close $f.
5a20: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
5a30: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 lappend l [stri
5a40: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 ng compare [lind
5a50: 65 78 20 24 70 20 30 5d 20 31 32 37 2e 30 2e 30 ex $p 0] 127.0.0
5a60: 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 .1]. lappend
5a70: 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 l [string compar
5a80: 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 e [lindex $p 2]
5a90: 32 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 2820]. lappen
5aa0: 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d d l [llength $p]
5ab0: 0a 7d 20 7b 30 20 30 20 33 7d 0a 74 65 73 74 20 .} {0 0 3}.test
5ac0: 73 6f 63 6b 65 74 2d 37 2e 32 20 7b 74 65 73 74 socket-7.2 {test
5ad0: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
5ae0: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
5af0: 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 cket stdio pcCra
5b00: 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 sh} {. remove
5b10: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
5b20: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
5b30: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
5b40: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
5b50: 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 uire tls..tls::s
5b60: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
5b70: 63 65 70 74 20 32 38 32 31 0a 09 70 72 6f 63 20 cept 2821..proc
5b80: 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 accept args {..
5b90: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
5ba0: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
5bb0: 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 puts ready..set
5bc0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
5bd0: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5be0: 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 out"]..vwait x..
5bf0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
5c00: 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c mer. }. cl
5c10: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
5c20: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5c30: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5c40: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
5c50: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
5c60: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
5c70: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 31 t 127.0.0.1 2821
5c80: 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f ]. set p [fco
5c90: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
5ca0: 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 name]. close
5cb0: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a $s. close $f.
5cc0: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
5cd0: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e lappend l [llen
5ce0: 67 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 gth $p]. lapp
5cf0: 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 end l [lindex $p
5d00: 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 0]. lappend
5d10: 6c 20 5b 65 78 70 72 20 5b 6c 69 6e 64 65 78 20 l [expr [lindex
5d20: 24 70 20 32 5d 20 3d 3d 20 32 38 32 31 5d 0a 7d $p 2] == 2821].}
5d30: 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d {3 127.0.0.1 0}
5d40: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 33 .test socket-7.3
5d50: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
5d60: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
5d70: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
5d80: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
5d90: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
5da0: 65 70 74 20 32 38 32 32 5d 0a 20 20 20 20 73 65 ept 2822]. se
5db0: 74 20 6c 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t l [fconfigure
5dc0: 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s]. close $s
5dd0: 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 . update.
5de0: 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d 20 31 32 0a llength $l.} 12.
5df0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 34 20 test socket-7.4
5e00: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
5e10: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
5e20: 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 } {socket pcCras
5e30: 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b h} {. set s [
5e40: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
5e50: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 33 5d ver accept 2823]
5e60: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
5e70: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 {s a p} {..glob
5e80: 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f al x..set x [fco
5e90: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
5ea0: 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a name]..close $s.
5eb0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
5ec0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 [tls::socket [i
5ed0: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 nfo hostname] 28
5ee0: 32 33 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 23]. set time
5ef0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
5f00: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5f10: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
5f20: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
5f30: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
5f40: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
5f50: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
5f60: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
5f70: 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 dex $x 2] [lleng
5f80: 74 68 20 24 78 5d 0a 7d 20 7b 32 38 32 33 20 33 th $x].} {2823 3
5f90: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 }..test socket-7
5fa0: 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .5 {testing sock
5fb0: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
5fc0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 75 6e 69 ons} {socket uni
5fd0: 78 4f 72 50 63 20 70 63 43 72 61 73 68 7d 20 7b xOrPc pcCrash} {
5fe0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
5ff0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6000: 61 63 63 65 70 74 20 32 38 32 39 5d 0a 20 20 20 accept 2829].
6010: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
6020: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 a p} {..global x
6030: 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 ..set x [fconfig
6040: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 ure $s -sockname
6050: 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 ]..close $s.
6060: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
6070: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
6080: 30 2e 31 20 32 38 32 39 5d 0a 20 20 20 20 73 65 0.1 2829]. se
6090: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
60a0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
60b0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
60c0: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
60d0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
60e0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
60f0: 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c se $s1. set l
6100: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
6110: 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 5d 20 l [lindex $x 0]
6120: 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c [lindex $x 2] [l
6130: 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 31 32 length $x].} {12
6140: 37 2e 30 2e 30 2e 31 20 32 38 32 39 20 33 7d 0a 7.0.0.1 2829 3}.
6150: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 38 2e 31 .test socket-8.1
6160: 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 63 {testing -async
6170: 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 73 flag on sockets
6180: 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 } {socket pcCras
6190: 68 7d 20 7b 0a 20 20 20 20 23 20 4e 4f 54 45 3a h} {. # NOTE:
61a0: 20 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 This test may f
61b0: 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 ail on some Sola
61c0: 72 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e ris 2.4 systems.
61d0: 20 49 66 20 69 74 20 64 6f 65 73 2c 0a 20 20 20 If it does,.
61e0: 20 23 20 63 68 65 63 6b 20 74 68 61 74 20 79 6f # check that yo
61f0: 75 20 68 61 76 65 20 74 68 65 73 65 20 70 61 74 u have these pat
6200: 63 68 65 73 20 69 6e 73 74 61 6c 6c 65 64 20 28 ches installed (
6210: 75 73 69 6e 67 20 73 68 6f 77 72 65 76 20 2d 70 using showrev -p
6220: 29 3a 0a 20 20 20 20 23 0a 20 20 20 20 23 20 31 ):. #. # 1
6230: 30 31 39 30 37 2d 30 35 2c 20 31 30 31 39 32 35 01907-05, 101925
6240: 2d 30 32 2c 20 31 30 31 39 34 35 2d 31 34 2c 20 -02, 101945-14,
6250: 31 30 31 39 35 39 2d 30 33 2c 20 31 30 31 39 36 101959-03, 10196
6260: 39 2d 30 35 2c 20 31 30 31 39 37 33 2d 30 33 2c 9-05, 101973-03,
6270: 0a 20 20 20 20 23 20 31 30 31 39 37 37 2d 30 33 . # 101977-03
6280: 2c 20 31 30 31 39 38 31 2d 30 32 2c 20 31 30 31 , 101981-02, 101
6290: 39 38 35 2d 30 31 2c 20 31 30 32 30 30 31 2d 30 985-01, 102001-0
62a0: 33 2c 20 31 30 32 30 30 33 2d 30 31 2c 20 31 30 3, 102003-01, 10
62b0: 32 30 30 37 2d 30 31 2c 0a 20 20 20 20 23 20 31 2007-01,. # 1
62c0: 30 32 30 31 31 2d 30 32 2c 20 31 30 32 30 32 34 02011-02, 102024
62d0: 2d 30 31 2c 20 31 30 32 30 33 39 2d 30 31 2c 20 -01, 102039-01,
62e0: 31 30 32 30 34 34 2d 30 31 2c 20 31 30 32 30 34 102044-01, 10204
62f0: 38 2d 30 31 2c 20 31 30 32 30 36 32 2d 30 33 2c 8-01, 102062-03,
6300: 0a 20 20 20 20 23 20 31 30 32 30 36 36 2d 30 34 . # 102066-04
6310: 2c 20 31 30 32 30 37 30 2d 30 31 2c 20 31 30 32 , 102070-01, 102
6320: 31 30 35 2d 30 31 2c 20 31 30 32 31 35 33 2d 30 105-01, 102153-0
6330: 33 2c 20 31 30 32 32 31 36 2d 30 31 2c 20 31 30 3, 102216-01, 10
6340: 32 32 33 32 2d 30 31 2c 0a 20 20 20 20 23 20 31 2232-01,. # 1
6350: 30 31 38 37 38 2d 30 33 2c 20 31 30 31 38 37 39 01878-03, 101879
6360: 2d 30 31 2c 20 31 30 31 38 38 30 2d 30 33 2c 20 -01, 101880-03,
6370: 31 30 31 39 33 33 2d 30 31 2c 20 31 30 31 39 35 101933-01, 10195
6380: 30 2d 30 31 2c 20 31 30 32 30 33 30 2d 30 31 2c 0-01, 102030-01,
6390: 0a 20 20 20 20 23 20 31 30 32 30 35 37 2d 30 38 . # 102057-08
63a0: 2c 20 31 30 32 31 34 30 2d 30 31 2c 20 31 30 31 , 102140-01, 101
63b0: 39 32 30 2d 30 32 2c 20 31 30 31 39 32 31 2d 30 920-02, 101921-0
63c0: 39 2c 20 31 30 31 39 32 32 2d 30 37 2c 20 31 30 9, 101922-07, 10
63d0: 31 39 32 33 2d 30 33 0a 20 20 20 20 23 0a 20 20 1923-03. #.
63e0: 20 20 23 20 49 66 20 61 66 74 65 72 20 69 6e 73 # If after ins
63f0: 74 61 6c 6c 69 6e 67 20 74 68 65 73 65 20 70 61 talling these pa
6400: 74 63 68 65 73 20 79 6f 75 20 61 72 65 20 73 74 tches you are st
6410: 69 6c 6c 20 65 78 70 65 72 69 65 6e 63 69 6e 67 ill experiencing
6420: 20 61 0a 20 20 20 20 23 20 70 72 6f 62 6c 65 6d a. # problem
6430: 2c 20 70 6c 65 61 73 65 20 65 6d 61 69 6c 20 6a , please email j
6440: 79 6c 40 65 6e 67 2e 73 75 6e 2e 63 6f 6d 2e 20 yl@eng.sun.com.
6450: 57 65 20 68 61 76 65 20 6e 6f 74 20 6f 62 73 65 We have not obse
6460: 72 76 65 64 20 74 68 69 73 0a 20 20 20 20 23 20 rved this. #
6470: 66 61 69 6c 75 72 65 20 6f 6e 20 53 6f 6c 61 72 failure on Solar
6480: 69 73 20 32 2e 35 2c 20 73 6f 20 61 6e 6f 74 68 is 2.5, so anoth
6490: 65 72 20 6f 70 74 69 6f 6e 20 28 69 6e 73 74 65 er option (inste
64a0: 61 64 20 6f 66 20 69 6e 73 74 61 6c 6c 69 6e 67 ad of installing
64b0: 0a 20 20 20 20 23 20 74 68 65 73 65 20 70 61 74 . # these pat
64c0: 63 68 65 73 29 20 69 73 20 74 6f 20 75 70 67 72 ches) is to upgr
64d0: 61 64 65 20 74 6f 20 53 6f 6c 61 72 69 73 20 32 ade to Solaris 2
64e0: 2e 35 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 .5.. set s [t
64f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
6500: 65 72 20 61 63 63 65 70 74 20 32 38 33 30 5d 0a er accept 2830].
6510: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
6520: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
6530: 6c 20 78 0a 09 70 75 74 73 20 24 73 20 62 79 65 l x..puts $s bye
6540: 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 ..close $s..set
6550: 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 x done. }.
6560: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
6570: 63 6b 65 74 20 2d 61 73 79 6e 63 20 5b 69 6e 66 cket -async [inf
6580: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 o hostname] 2830
6590: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
65a0: 20 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 73 set z [gets $s
65b0: 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 1]. close $s.
65c0: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
65d0: 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 set z.} bye..t
65e0: 65 73 74 20 73 6f 63 6b 65 74 2d 39 2e 31 20 7b est socket-9.1 {
65f0: 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 testing spurious
6600: 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 events} {socket
6610: 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 pcCrash} {.
6620: 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 set len 0. se
6630: 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 t spurious 0.
6640: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
6650: 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 proc readlittle
6660: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 {s} {..global sp
6670: 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a urious done len.
6680: 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 .set l [read $s
6690: 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 1]..if {[string
66a0: 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d length $l] == 0}
66b0: 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f {.. if {![eo
66c0: 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 f $s]} {...incr
66d0: 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 spurious.. }
66e0: 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 else {...close $
66f0: 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 s...set done 1..
6700: 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a }..} else {.
6710: 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 . incr len [s
6720: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
6730: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ..}. }. pr
6740: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
6750: 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 } {..fconfigure
6760: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f $s -buffering no
6770: 6e 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 ne -blocking off
6780: 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 ..fileevent $s r
6790: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 72 65 eadable [list re
67a0: 61 64 6c 69 74 74 6c 65 20 24 73 5d 0a 20 20 20 adlittle $s].
67b0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
67c0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
67d0: 72 20 61 63 63 65 70 74 20 32 38 33 31 5d 0a 20 r accept 2831].
67e0: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
67f0: 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 ocket [info host
6800: 6e 61 6d 65 5d 20 32 38 33 31 5d 0a 20 20 20 20 name] 2831].
6810: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
6820: 24 63 20 30 31 32 33 34 35 36 37 38 39 30 31 32 $c 0123456789012
6830: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
6840: 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 9012345678901234
6850: 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 56789. close
6860: 24 63 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 $c. set timer
6870: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
6880: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
6890: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f t"]. vwait do
68a0: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
68b0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
68c0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 lose $s. list
68d0: 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a $spurious $len.
68e0: 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 20 73 } {0 50}..test s
68f0: 6f 63 6b 65 74 2d 39 2e 32 20 7b 74 65 73 74 69 ocket-9.2 {testi
6900: 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 ng async write,
6910: 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 73 fileevents, flus
6920: 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 h on close} {soc
6930: 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 ket pcCrash} {.
6940: 20 20 20 73 65 74 20 66 69 72 73 74 62 6c 6f 63 set firstbloc
6950: 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 k "". for {se
6960: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 t i 0} {$i < 5}
6970: 7b 69 6e 63 72 20 69 7d 20 7b 73 65 74 20 66 69 {incr i} {set fi
6980: 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 rstblock "a$firs
6990: 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 tblock$firstbloc
69a0: 6b 22 7d 0a 20 20 20 20 73 65 74 20 73 65 63 6f k"}. set seco
69b0: 6e 64 62 6c 6f 63 6b 20 22 22 0a 20 20 20 20 66 ndblock "". f
69c0: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
69d0: 20 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d 20 < 16} {incr i}
69e0: 7b 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f {..set secondblo
69f0: 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 ck "b$secondbloc
6a00: 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 20 k$secondblock".
6a10: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 20 5b }. set l [
6a20: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6a30: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 32 5d ver accept 2832]
6a40: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
6a50: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
6a60: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
6a70: 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 ing 0 -translati
6a80: 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a on lf -buffersiz
6a90: 65 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 e 16384 \...-buf
6aa0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c fering line..fil
6ab0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
6ac0: 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 le "readable $s"
6ad0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
6ae0: 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 readable {s} {..
6af0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
6b00: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
6b10: 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 adable {}..after
6b20: 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 1000 respond $s
6b30: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
6b40: 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 respond {s} {..g
6b50: 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b lobal firstblock
6b60: 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e ..puts -nonewlin
6b70: 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b e $s $firstblock
6b80: 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 72 69 ..after 1000 wri
6b90: 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a tedata $s. }.
6ba0: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 proc writeda
6bb0: 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c ta {s} {..global
6bc0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 secondblock..pu
6bd0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
6be0: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 $secondblock..c
6bf0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
6c00: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6c10: 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e cket [info hostn
6c20: 61 6d 65 5d 20 32 38 33 32 5d 0a 20 20 20 20 66 ame] 2832]. f
6c30: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
6c40: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 ocking 0 -trans
6c50: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
6c60: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
6c70: 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 0. puts $s h
6c80: 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 ello. proc re
6c90: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
6ca0: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 al count done..s
6cb0: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 et l [read $s]..
6cc0: 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 incr count [stri
6cd0: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 ng length $l]..i
6ce0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
6cf0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 close $s..
6d00: 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a set done 1..}.
6d10: 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 }. fileev
6d20: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
6d30: 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 "readit $s".
6d40: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6d50: 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 10000 "set done
6d60: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
6d70: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
6d80: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
6d90: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 6c mer. close $l
6da0: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d . set count.}
6db0: 20 36 35 35 36 36 0a 0a 74 65 73 74 20 73 6f 63 65566..test soc
6dc0: 6b 65 74 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 ket-9.3 {testing
6dd0: 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d EOF stickyness}
6de0: 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 68 {socket pcCrash
6df0: 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 } {. proc cou
6e00: 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a nt_to_eof {s} {.
6e10: 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f .global count do
6e20: 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 20 6c 20 ne timer..set l
6e30: 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b [gets $s]..if {[
6e40: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
6e50: 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 20 20 incr count..
6e60: 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 7d 20 if {$count > 9}
6e70: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 {...close $s...s
6e80: 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 09 73 et done true...s
6e90: 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 69 73 et count {eof is
6ea0: 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 sticky}...after
6eb0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
6ec0: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
6ed0: 20 20 20 70 72 6f 63 20 74 69 6d 65 72 70 72 6f proc timerpro
6ee0: 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 c {} {..global d
6ef0: 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 65 74 one count c..set
6f00: 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 74 20 done true..set
6f10: 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 65 6e count {timer wen
6f20: 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 6e 6f t off, eof is no
6f30: 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 t sticky}..close
6f40: 20 24 63 0a 20 20 20 20 7d 09 0a 20 20 20 20 73 $c. }.. s
6f50: 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 73 et count 0. s
6f60: 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a 20 20 et done false.
6f70: 20 20 70 72 6f 63 20 77 72 69 74 65 5f 74 68 65 proc write_the
6f80: 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 n_close {s} {..p
6f90: 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 uts $s bye..clos
6fa0: 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 e $s. }. p
6fb0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
6fc0: 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 p} {..fconfigure
6fd0: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
6fe0: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
6ff0: 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 lf..fileevent $
7000: 73 20 77 72 69 74 61 62 6c 65 20 22 77 72 69 74 s writable "writ
7010: 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 24 73 22 e_then_close $s"
7020: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
7030: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
7040: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
7050: 33 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 3]. set c [tl
7060: 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 s::socket [info
7070: 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 33 5d 0a hostname] 2833].
7080: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
7090: 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 20 c -blocking off
70a0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
70b0: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a -translation lf.
70c0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
70d0: 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 readable "count
70e0: 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 _to_eof $c".
70f0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
7100: 20 31 30 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 1000 timerproc]
7110: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
7120: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
7130: 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f set count.} {eo
7140: 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 f is sticky}..re
7150: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
7160: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 30 2e .test socket-10.
7170: 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 1 {testing socke
7180: 74 20 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 t accept callbac
7190: 6b 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 6e 67 k error handling
71a0: 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 } {socket pcCras
71b0: 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 6f 74 h} {. set got
71c0: 65 72 72 6f 72 20 30 0a 20 20 20 20 70 72 6f 63 error 0. proc
71d0: 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 67 bgerror args {g
71e0: 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 3b 20 lobal goterror;
71f0: 73 65 74 20 67 6f 74 65 72 72 6f 72 20 31 7d 0a set goterror 1}.
7200: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
7210: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
7220: 63 63 65 70 74 20 32 38 39 38 5d 0a 20 20 20 20 ccept 2898].
7230: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
7240: 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 p} {close $s; e
7250: 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 20 rror}. set c
7260: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
7270: 2e 30 2e 30 2e 31 20 32 38 39 38 5d 0a 20 20 20 .0.0.1 2898].
7280: 20 76 77 61 69 74 20 67 6f 74 65 72 72 6f 72 0a vwait goterror.
7290: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
72a0: 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 close $c. se
72b0: 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 31 0a 0a t goterror.} 1..
72c0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 test socket-11.1
72d0: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
72e0: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
72f0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
7300: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d r} {. sendCom
7310: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
7320: 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 et9_1_test_serve
7330: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
7340: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
7350: 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 34]..proc accept
7360: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
7370: 70 75 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 20 puts $s done..
7380: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
7390: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
73a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
73b0: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 34 5d teServerIP 2834]
73c0: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
73d0: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
73e0: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
73f0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
7400: 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 9_1_test_server}
7410: 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e . set r.} don
7420: 65 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 e.test socket-11
7430: 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 .2 {client speci
7440: 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b fies its port} {
7450: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
7460: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
7470: 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 {. if {[info
7480: 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a exists port]} {.
7490: 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d .incr port. }
74a0: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 else {..set por
74b0: 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b 20 5b t [expr 2048 + [
74c0: 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 20 7d pid]%1024]. }
74d0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
74e0: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f {..set socket9_
74f0: 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 2_test_server [t
7500: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
7510: 65 72 20 61 63 63 65 70 74 20 32 38 33 35 5d 0a er accept 2835].
7520: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
7530: 61 20 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 a p} {.. puts
7540: 20 24 73 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 $s $p.. clos
7550: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
7560: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
7570: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 6f cket -myport $po
7580: 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 rt $remoteServer
7590: 49 50 20 32 38 33 35 5d 0a 20 20 20 20 73 65 74 IP 2835]. set
75a0: 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 r [gets $s].
75b0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
75c0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
75d0: 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 $socket9_2_test
75e0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 _server}. if
75f0: 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a {$r == $port} {.
7600: 09 73 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 .set result ok.
7610: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
7620: 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 result broken.
7630: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 }. set res
7640: 75 6c 74 0a 7d 20 6f 6b 0a 74 65 73 74 20 73 6f ult.} ok.test so
7650: 63 6b 65 74 2d 31 31 2e 33 20 7b 74 72 79 69 6e cket-11.3 {tryin
7660: 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f g to connect, no
7670: 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 server} {socket
7680: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
7690: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
76a0: 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 set status ok.
76b0: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 if {![catch {s
76c0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
76d0: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
76e0: 70 20 32 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 p 2836]}]} {..if
76f0: 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 {![catch {gets
7700: 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 $s}]} {.. set
7710: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
7720: 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 }..close $s.
7730: 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 }. set status
7740: 0a 7d 20 6f 6b 0a 74 65 73 74 20 73 6f 63 6b 65 .} ok.test socke
7750: 74 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 t-11.4 {remote e
7760: 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b cho, one line} {
7770: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
7780: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
7790: 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e {. sendComman
77a0: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
77b0: 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 20 0_6_test_server
77c0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
77d0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
77e0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
77f0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 s a p} {.. fi
7800: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
7810: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
7820: 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 s].. fconfigu
7830: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
7840: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
7850: 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 on crlf..}..proc
7860: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
7870: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
7880: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
7890: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
78a0: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
78b0: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 .puts $s $l..
78c0: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
78d0: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
78e0: 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 et $remoteServer
78f0: 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 2836]. fco
7900: 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e nfigure $f -tran
7910: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
7920: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
7930: 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 puts $f hello.
7940: 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 set r [gets $
7950: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
7960: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
7970: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
7980: 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _6_test_server}.
7990: 20 20 20 20 73 65 74 20 72 0a 7d 20 68 65 6c 6c set r.} hell
79a0: 6f 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 o.test socket-11
79b0: 2e 35 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c .5 {remote echo,
79c0: 20 35 30 20 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 50 lines} {sock
79d0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
79e0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
79f0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
7a00: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f .set socket10_7_
7a10: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
7a20: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
7a30: 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 accept 2836]..p
7a40: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
7a50: 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 p} {.. fileev
7a60: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
7a70: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
7a80: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
7a90: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
7aa0: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 e -translation c
7ab0: 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 rlf..}..proc ech
7ac0: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
7ad0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
7ae0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
7af0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
7b00: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
7b10: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
7b20: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
7b30: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 f [tls::socket $
7b40: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
7b50: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
7b60: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
7b70: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
7b80: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 ing line. for
7b90: 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 7b 24 63 {set cnt 0} {$c
7ba0: 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 63 nt < 50} {incr c
7bb0: 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 66 20 22 nt} {..puts $f "
7bc0: 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 69 66 hello, $cnt"..if
7bd0: 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 {[string compar
7be0: 65 20 5b 67 65 74 73 20 24 66 5d 20 22 68 65 6c e [gets $f] "hel
7bf0: 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 3d 20 30 7d lo, $cnt"] != 0}
7c00: 20 7b 0a 09 20 20 20 20 62 72 65 61 6b 0a 09 7d {.. break..}
7c10: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
7c20: 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $f. sendComm
7c30: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
7c40: 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 et10_7_test_serv
7c50: 65 72 7d 0a 20 20 20 20 73 65 74 20 63 6e 74 0a er}. set cnt.
7c60: 7d 20 35 30 0a 23 20 4d 61 63 69 6e 74 6f 73 68 } 50.# Macintosh
7c70: 20 73 6f 63 6b 65 74 73 20 63 61 6e 20 68 61 76 sockets can hav
7c80: 65 20 6d 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 e more than one
7c90: 73 65 72 76 65 72 20 70 65 72 20 70 6f 72 74 0a server per port.
7ca0: 69 66 20 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 if {$tcl_platfor
7cb0: 6d 28 70 6c 61 74 66 6f 72 6d 29 20 3d 3d 20 22 m(platform) == "
7cc0: 6d 61 63 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 macintosh"} {.
7cd0: 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 set conflictRe
7ce0: 73 75 6c 74 20 7b 30 20 32 38 33 36 7d 0a 7d 20 sult {0 2836}.}
7cf0: 65 6c 73 65 20 7b 0a 20 20 20 20 73 65 74 20 63 else {. set c
7d00: 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 onflictResult {1
7d10: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
7d20: 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 socket: address
7d30: 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d already in use}}
7d40: 0a 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 .}.test socket-1
7d50: 31 2e 36 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 1.6 {socket conf
7d60: 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f lict} {socket do
7d70: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
7d80: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 erver} {. set
7d90: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
7da0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
7db0: 32 38 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 2836]. if {[c
7dc0: 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b 74 6c atch {set s2 [tl
7dd0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
7de0: 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 7d 20 r accept 2836]}
7df0: 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 72 65 73 msg]} {..set res
7e00: 75 6c 74 20 5b 6c 69 73 74 20 31 20 24 6d 73 67 ult [list 1 $msg
7e10: 5d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 ]. } else {..
7e20: 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 set result [list
7e30: 20 30 20 5b 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 0 [lindex [fcon
7e40: 66 69 67 75 72 65 20 24 73 32 20 2d 73 6f 63 6b figure $s2 -sock
7e50: 6e 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 name] 2]]..close
7e60: 20 24 73 32 0a 20 20 20 20 7d 0a 20 20 20 20 63 $s2. }. c
7e70: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
7e80: 20 72 65 73 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c result.} $confl
7e90: 69 63 74 52 65 73 75 6c 74 0a 74 65 73 74 20 73 ictResult.test s
7ea0: 6f 63 6b 65 74 2d 31 31 2e 37 20 7b 73 65 72 76 ocket-11.7 {serv
7eb0: 65 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 er with several
7ec0: 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 clients} {socket
7ed0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
7ee0: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
7ef0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
7f00: 65 74 20 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 et socket10_9_te
7f10: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
7f20: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
7f30: 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f ccept 2836]..pro
7f40: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
7f50: 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 {.. fconfigu
7f60: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
7f70: 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 line.. filee
7f80: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
7f90: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
7fa0: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
7fb0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
7fc0: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
7fd0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
7fe0: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
7ff0: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
8000: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
8010: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b }. set s1 [
8020: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d tls::socket $rem
8030: 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 oteServerIP 2836
8040: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
8050: 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 $s1 -buffering
8060: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 line. set s2
8070: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
8080: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 moteServerIP 283
8090: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
80a0: 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 e $s2 -buffering
80b0: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 line. set s3
80c0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 [tls::socket $r
80d0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 emoteServerIP 28
80e0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
80f0: 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e re $s3 -bufferin
8100: 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b g line. for {
8110: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
8120: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
8130: 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 puts $s1 hello,s
8140: 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 1..gets $s1..put
8150: 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 s $s2 hello,s2..
8160: 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 gets $s2..puts $
8170: 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 s3 hello,s3..get
8180: 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 s $s3. }.
8190: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c close $s1. cl
81a0: 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 ose $s2. clos
81b0: 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f e $s3. sendCo
81c0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
81d0: 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 cket10_9_test_se
81e0: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 69 0a rver}. set i.
81f0: 7d 20 31 30 30 20 20 20 20 0a 74 65 73 74 20 73 } 100 .test s
8200: 6f 63 6b 65 74 2d 31 31 2e 38 20 7b 63 6c 69 65 ocket-11.8 {clie
8210: 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 nt with several
8220: 73 65 72 76 65 72 73 7d 20 7b 73 6f 63 6b 65 74 servers} {socket
8230: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
8240: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
8250: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
8260: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
8270: 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 et -server "acce
8280: 70 74 20 34 30 30 33 22 20 34 30 30 33 5d 0a 09 pt 4003" 4003]..
8290: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
82a0: 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 ket -server "acc
82b0: 65 70 74 20 34 30 30 34 22 20 34 30 30 34 5d 0a ept 4004" 4004].
82c0: 09 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f .set s3 [tls::so
82d0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 cket -server "ac
82e0: 63 65 70 74 20 34 30 30 35 22 20 34 30 30 35 5d cept 4005" 4005]
82f0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 6d ..proc accept {m
8300: 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 p s a p} {..
8310: 70 75 74 73 20 24 73 20 24 6d 70 0a 09 20 20 20 puts $s $mp..
8320: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
8330: 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 }. set s1 [t
8340: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
8350: 74 65 53 65 72 76 65 72 49 50 20 34 30 30 33 5d teServerIP 4003]
8360: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
8370: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
8380: 53 65 72 76 65 72 49 50 20 34 30 30 34 5d 0a 20 ServerIP 4004].
8390: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
83a0: 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 socket $remoteSe
83b0: 72 76 65 72 49 50 20 34 30 30 35 5d 0a 20 20 20 rverIP 4005].
83c0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
83d0: 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 ppend l [gets $s
83e0: 31 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 1] [gets $s1] [e
83f0: 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 of $s1] [gets $s
8400: 32 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 2] [gets $s2] [e
8410: 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 of $s2] \..[gets
8420: 20 24 73 33 5d 20 5b 67 65 74 73 20 24 73 33 5d $s3] [gets $s3]
8430: 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 [eof $s3]. c
8440: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f lose $s1. clo
8450: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
8460: 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d $s3. sendCom
8470: 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 mand {..close $s
8480: 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 1..close $s2..cl
8490: 6f 73 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ose $s3. }.
84a0: 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 set l.} {4003
84b0: 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 20 34 {} 1 4004 {} 1 4
84c0: 30 30 35 20 7b 7d 20 31 7d 0a 74 65 73 74 20 73 005 {} 1}.test s
84d0: 6f 63 6b 65 74 2d 31 31 2e 39 20 7b 61 63 63 65 ocket-11.9 {acce
84e0: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
84f0: 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 r} {socket doTes
8500: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
8510: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 er} {. set s
8520: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
8530: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
8540: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
8550: 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 t {s a p} {expr
8560: 31 30 20 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 10 / 0}. proc
8570: 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a bgerror args {.
8580: 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 .global x..set x
8590: 20 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 $args. }.
85a0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e if {[catch {sen
85b0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 dCommand {..
85c0: 73 65 74 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 set peername [fc
85d0: 6f 6e 66 69 67 75 72 65 20 24 63 61 6c 6c 65 72 onfigure $caller
85e0: 53 6f 63 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 Socket -peername
85f0: 5d 0a 09 20 20 20 20 73 65 74 20 73 20 5b 74 6c ].. set s [tl
8600: 73 3a 3a 73 6f 63 6b 65 74 20 5b 6c 69 6e 64 65 s::socket [linde
8610: 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d 20 32 x $peername 0] 2
8620: 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 65 20 836].. close
8630: 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 67 5d $s. . }} msg]
8640: 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a 09 65 } {..close $s..e
8650: 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 7d 0a rror $msg. }.
8660: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
8670: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
8680: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
8690: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 vwait x. af
86a0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
86b0: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
86c0: 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 72 6f rename bgerro
86d0: 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d r {}. set x.}
86e0: 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a 65 72 {{divide by zer
86f0: 6f 7d 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d o}}.test socket-
8700: 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 20 73 11.10 {testing s
8710: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
8720: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
8730: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
8740: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
8750: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
8760: 74 20 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 t socket10_12_te
8770: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
8780: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
8790: 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f ccept 2836]..pro
87a0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
87b0: 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 {close $s}.
87c0: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
87d0: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
87e0: 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 ServerIP 2836].
87f0: 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 set p [fconfi
8800: 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d gure $s -peernam
8810: 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 66 63 e]. set n [fc
8820: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 onfigure $s -soc
8830: 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c kname]. set l
8840: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
8850: 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 l [lindex $p 2]
8860: 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c [llength $p] [ll
8870: 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 63 6c ength $p]. cl
8880: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 ose $s. sendC
8890: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
88a0: 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f ocket10_12_test_
88b0: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
88c0: 6c 0a 7d 20 7b 32 38 33 36 20 33 20 33 7d 0a 74 l.} {2836 3 3}.t
88d0: 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 31 est socket-11.11
88e0: 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f {testing spurio
88f0: 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b us events} {sock
8900: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
8910: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
8920: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
8930: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 33 .set socket10_13
8940: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
8950: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
8960: 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 r accept 2836]..
8970: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
8980: 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 p} {.. fconf
8990: 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c igure $s -transl
89a0: 61 74 69 6f 6e 20 22 61 75 74 6f 20 6c 66 22 0a ation "auto lf".
89b0: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 20 77 . after 100 w
89c0: 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 7d 0a 09 ritesome $s..}..
89d0: 70 72 6f 63 20 77 72 69 74 65 73 6f 6d 65 20 7b proc writesome {
89e0: 73 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 7b 73 s} {.. for {s
89f0: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 et i 0} {$i < 10
8a00: 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 0} {incr i} {...
8a10: 70 75 74 73 20 24 73 20 22 6c 69 6e 65 20 24 69 puts $s "line $i
8a20: 20 66 72 6f 6d 20 72 65 6d 6f 74 65 20 73 65 72 from remote ser
8a30: 76 65 72 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 ver".. }..
8a40: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
8a50: 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 }. set len 0
8a60: 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 . set spuriou
8a70: 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 s 0. set done
8a80: 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 0. proc read
8a90: 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c little {s} {..gl
8aa0: 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f obal spurious do
8ab0: 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 ne len..set l [r
8ac0: 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b ead $s 1]..if {[
8ad0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
8ae0: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 ] == 0} {.. i
8af0: 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a f {![eof $s]} {.
8b00: 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a ..incr spurious.
8b10: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
8b20: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 close $s...set d
8b30: 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 one 1.. }..}
8b40: 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 else {.. incr
8b50: 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e len [string len
8b60: 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d gth $l]..}. }
8b70: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
8b80: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
8b90: 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 erverIP 2836].
8ba0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
8bb0: 65 61 64 61 62 6c 65 20 22 72 65 61 64 6c 69 74 eadable "readlit
8bc0: 74 6c 65 20 24 63 22 0a 20 20 20 20 73 65 74 20 tle $c". set
8bd0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
8be0: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
8bf0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
8c00: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
8c10: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
8c20: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8c30: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
8c40: 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _13_test_server}
8c50: 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 69 . list $spuri
8c60: 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 ous $len.} {0 26
8c70: 39 30 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 90}.test socket-
8c80: 31 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 20 45 11.12 {testing E
8c90: 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b OF stickyness} {
8ca0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8cb0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
8cc0: 7b 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 65 {. set counte
8cd0: 72 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 r 0. set done
8ce0: 20 30 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 0. proc coun
8cf0: 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 t_up {s} {..glob
8d00: 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 al counter done
8d10: 61 66 74 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 after_id..set l
8d20: 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b [gets $s]..if {[
8d30: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
8d40: 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 incr counter..
8d50: 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e if {$counter >
8d60: 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 9} {...set done
8d70: 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d {EOF is sticky}
8d80: 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 ...after cancel
8d90: 24 61 66 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 $after_id...clos
8da0: 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 e $s.. }..}.
8db0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 }. proc ti
8dc0: 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c med_out {} {..gl
8dd0: 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 obal c done..set
8de0: 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 done {timed_out
8df0: 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 , EOF is not sti
8e00: 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 cky}..close $c.
8e10: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d }. sendCom
8e20: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
8e30: 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 et10_14_test_ser
8e40: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
8e50: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
8e60: 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 2836]..proc acce
8e70: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
8e80: 20 20 61 66 74 65 72 20 31 30 30 20 63 6c 6f 73 after 100 clos
8e90: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
8ea0: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
8eb0: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
8ec0: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 erIP 2836]. f
8ed0: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
8ee0: 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 able "count_up $
8ef0: 63 22 0a 20 20 20 20 73 65 74 20 61 66 74 65 72 c". set after
8f00: 5f 69 64 20 5b 61 66 74 65 72 20 31 30 30 30 20 _id [after 1000
8f10: 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 timed_out]. v
8f20: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 wait done. se
8f30: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
8f40: 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 $socket10_14_te
8f50: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
8f60: 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 et done.} {EOF i
8f70: 73 20 73 74 69 63 6b 79 7d 0a 74 65 73 74 20 73 s sticky}.test s
8f80: 6f 63 6b 65 74 2d 31 31 2e 31 33 20 7b 74 65 73 ocket-11.13 {tes
8f90: 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 ting async write
8fa0: 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 , async flush, a
8fb0: 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b sync close} \..{
8fc0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8fd0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
8fe0: 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 {. proc readi
8ff0: 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 t {s} {..global
9000: 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 count done..set
9010: 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 l [read $s]..inc
9020: 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 r count [string
9030: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b length $l]..if {
9040: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 [eof $s]} {..
9050: 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 close $s.. s
9060: 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 et done 1..}.
9070: 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }. sendComma
9080: 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 nd {..set firstb
9090: 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 lock ""..for {se
90a0: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 t i 0} {$i < 5}
90b0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 73 65 74 {incr i} {...set
90c0: 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 firstblock "a$f
90d0: 69 72 73 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 irstblock$firstb
90e0: 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 73 65 lock"..}..set se
90f0: 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a 09 66 6f condblock ""..fo
9100: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
9110: 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b < 16} {incr i} {
9120: 0a 09 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 .. set second
9130: 62 6c 6f 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 block "b$secondb
9140: 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b lock$secondblock
9150: 22 0a 09 7d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 "..}..set l [tls
9160: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
9170: 20 61 63 63 65 70 74 20 32 38 34 35 5d 0a 09 70 accept 2845]..p
9180: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
9190: 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 p} {.. fconfi
91a0: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
91b0: 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e g 0 -translation
91c0: 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 lf -buffersize
91d0: 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 16384 \...-buffe
91e0: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 ring line.. f
91f0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
9200: 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 able "readable $
9210: 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 s"..}..proc read
9220: 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 able {s} {..
9230: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
9240: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
9250: 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 s readable {}..
9260: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 72 65 after 1000 re
9270: 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f spond $s..}..pro
9280: 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a c respond {s} {.
9290: 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 . global firs
92a0: 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 tblock.. puts
92b0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
92c0: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 firstblock..
92d0: 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 65 after 1000 write
92e0: 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 data $s..}..proc
92f0: 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b writedata {s} {
9300: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 .. global sec
9310: 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 ondblock.. pu
9320: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
9330: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 $secondblock..
9340: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
9350: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
9360: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d tls::socket $rem
9370: 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 34 35 oteServerIP 2845
9380: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
9390: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
93a0: 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 -trans lf -buffe
93b0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
93c0: 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 t count 0. pu
93d0: 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 ts $s hello.
93e0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
93f0: 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 dable "readit $s
9400: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
9410: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
9420: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
9430: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e "]. vwait don
9440: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
9450: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 el $timer. se
9460: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
9470: 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 $l}. set cou
9480: 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 nt.} 65566..test
9490: 20 73 6f 63 6b 65 74 2d 31 32 2e 31 20 7b 74 65 socket-12.1 {te
94a0: 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 sting inheritanc
94b0: 65 20 6f 66 20 73 65 72 76 65 72 20 73 6f 63 6b e of server sock
94c0: 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ets} \..{socket
94d0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
94e0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 eServer} {. r
94f0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
9500: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
9510: 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 20 script2.. #
9520: 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 20 Script1 is just
9530: 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 a 10 second dela
9540: 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 65 y. If the serve
9550: 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 r socket. # i
9560: 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 20 s inherited, it
9570: 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 will be held ope
9580: 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 n for 10 seconds
9590: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
95a0: 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 n script1 w].
95b0: 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 puts $f {..afte
95c0: 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 r 10000 exit..vw
95d0: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
95e0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
95f0: 20 20 20 20 23 20 53 63 72 69 70 74 32 20 63 72 # Script2 cr
9600: 65 61 74 65 73 20 74 68 65 20 73 65 72 76 65 72 eates the server
9610: 20 73 6f 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 socket, launche
9620: 73 20 73 63 72 69 70 74 31 2c 0a 20 20 20 20 23 s script1,. #
9630: 20 77 61 69 74 73 20 61 20 73 65 63 6f 6e 64 2c waits a second,
9640: 20 61 6e 64 20 65 78 69 74 73 2e 20 20 54 68 65 and exits. The
9650: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 server socket w
9660: 69 6c 6c 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 ill now. # be
9670: 20 63 6c 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 closed unless s
9680: 63 72 69 70 74 31 20 69 6e 68 65 72 69 74 65 64 cript1 inherited
9690: 20 69 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 it... set f
96a0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d [open script2 w]
96b0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
96c0: 73 74 20 73 65 74 20 74 63 6c 74 65 73 74 20 24 st set tcltest $
96d0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
96e0: 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 st]. puts $f
96f0: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
9700: 72 65 20 74 63 6c 74 65 73 74 0a 09 73 65 74 20 re tcltest..set
9710: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
9720: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
9730: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
9740: 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 6f 72 { file addr por
9750: 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 t } {.. close
9760: 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65 63 20 $file..}..exec
9770: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
9780: 65 73 74 20 73 63 72 69 70 74 31 20 26 0a 09 63 est script1 &..c
9790: 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 72 20 31 lose $f..after 1
97a0: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
97b0: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
97c0: 20 20 63 6c 6f 73 65 20 24 66 0a 09 0a 20 20 20 close $f...
97d0: 20 23 20 4c 61 75 6e 63 68 20 73 63 72 69 70 74 # Launch script
97e0: 32 20 61 6e 64 20 77 61 69 74 20 35 20 73 65 63 2 and wait 5 sec
97f0: 6f 6e 64 73 0a 0a 20 20 20 20 65 78 65 63 20 24 onds.. exec $
9800: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
9810: 73 74 20 73 63 72 69 70 74 32 20 26 0a 20 20 20 st script2 &.
9820: 20 61 66 74 65 72 20 35 30 30 30 20 7b 20 73 65 after 5000 { se
9830: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 t ok_to_proceed
9840: 31 20 7d 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 1 }. vwait ok
9850: 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 _to_proceed..
9860: 20 23 20 49 66 20 77 65 20 63 61 6e 20 73 74 69 # If we can sti
9870: 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 ll connect to th
9880: 65 20 73 65 72 76 65 72 2c 20 74 68 65 20 73 6f e server, the so
9890: 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 69 74 cket got inherit
98a0: 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 ed... if {[ca
98b0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
98c0: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 7d 127.0.0.1 2828}
98d0: 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 msg]} {..set x
98e0: 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 {server socket w
98f0: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
9900: 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 }. } else {..
9910: 63 6c 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 20 close $msg..set
9920: 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 x {server socket
9930: 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a was inherited}.
9940: 20 20 20 20 7d 0a 0a 20 20 20 20 72 65 6d 6f 76 }.. remov
9950: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
9960: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
9970: 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a 7d ipt2. set x.}
9980: 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 {server socket
9990: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
99a0: 64 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 d}.test socket-1
99b0: 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 2.2 {testing inh
99c0: 65 72 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 eritance of clie
99d0: 6e 74 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b nt sockets} \..{
99e0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
99f0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9a00: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
9a10: 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d script1. rem
9a20: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a oveFile script2.
9a30: 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 69 . # Script1 i
9a40: 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f s just a 10 seco
9a50: 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 nd delay. If th
9a60: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a e server socket.
9a70: 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 # is inherit
9a80: 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 ed, it will be h
9a90: 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 eld open for 10
9aa0: 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 seconds.. set
9ab0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 f [open script1
9ac0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
9ad0: 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 {..after 10000 e
9ae0: 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 xit..vwait forev
9af0: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
9b00: 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 se $f.. # Scr
9b10: 69 70 74 32 20 6f 70 65 6e 73 20 74 68 65 20 63 ipt2 opens the c
9b20: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 61 6e 64 lient socket and
9b30: 20 77 72 69 74 65 73 20 74 6f 20 69 74 2e 20 20 writes to it.
9b40: 49 74 20 74 68 65 6e 0a 20 20 20 20 23 20 6c 61 It then. # la
9b50: 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 20 61 unches script1 a
9b60: 6e 64 20 65 78 69 74 73 2e 20 20 49 66 20 74 68 nd exits. If th
9b70: 65 20 63 68 69 6c 64 20 70 72 6f 63 65 73 73 20 e child process
9b80: 69 6e 68 65 72 69 74 65 64 20 74 68 65 0a 20 20 inherited the.
9b90: 20 20 23 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 # client socke
9ba0: 74 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 77 69 t, the socket wi
9bb0: 6c 6c 20 73 74 69 6c 6c 20 62 65 20 6f 70 65 6e ll still be open
9bc0: 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 ... set f [op
9bd0: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
9be0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
9bf0: 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 set tcltest $::t
9c00: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d cltest::tcltest]
9c10: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
9c20: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
9c30: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 et 127.0.0.1 282
9c40: 39 5d 0a 09 65 78 65 63 20 24 3a 3a 74 63 6c 74 9]..exec $::tclt
9c50: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
9c60: 69 70 74 31 20 26 0a 09 70 75 74 73 20 24 66 20 ipt1 &..puts $f
9c70: 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 68 20 24 testing..flush $
9c80: 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 78 f..after 1000 ex
9c90: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
9ca0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
9cb0: 65 20 24 66 0a 0a 20 20 20 20 23 20 43 72 65 61 e $f.. # Crea
9cc0: 74 65 20 74 68 65 20 73 65 72 76 65 72 20 73 6f te the server so
9cd0: 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 20 73 65 cket.. set se
9ce0: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
9cf0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
9d00: 20 32 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 2829]. proc
9d10: 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f accept { file ho
9d20: 73 74 20 70 6f 72 74 20 7d 20 7b 0a 0a 09 23 20 st port } {...#
9d30: 57 68 65 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 When the client
9d40: 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 61 62 6c connects, establ
9d50: 69 73 68 20 74 68 65 20 72 65 61 64 20 68 61 6e ish the read han
9d60: 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 73 65 72 dler..global ser
9d70: 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 65 72 76 ver..close $serv
9d80: 65 72 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 66 er..fileevent $f
9d90: 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 ile readable [li
9da0: 73 74 20 67 65 74 64 61 74 61 20 24 66 69 6c 65 st getdata $file
9db0: 5d 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 ]..fconfigure $f
9dc0: 69 6c 65 20 2d 62 75 66 66 65 72 69 6e 67 20 6c ile -buffering l
9dd0: 69 6e 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a ine -blocking 0.
9de0: 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 .return. }.
9df0: 20 20 70 72 6f 63 20 67 65 74 64 61 74 61 20 7b proc getdata {
9e00: 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 65 file } {...# Re
9e10: 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 ad handler on th
9e20: 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 e accepted socke
9e30: 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 67 6c t...global x..gl
9e40: 6f 62 61 6c 20 66 61 69 6c 65 64 0a 09 73 65 74 obal failed..set
9e50: 20 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 7b status [catch {
9e60: 72 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 61 read $file} data
9e70: 5d 0a 09 69 66 20 7b 24 73 74 61 74 75 73 20 21 ]..if {$status !
9e80: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 = 0} {.. set
9e90: 78 20 7b 72 65 61 64 20 66 61 69 6c 65 64 2c 20 x {read failed,
9ea0: 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 61 7d error was $data}
9eb0: 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c .. catch { cl
9ec0: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 ose $file }..} e
9ed0: 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 lseif {[string c
9ee0: 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 61 5d ompare {} $data]
9ef0: 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b } {..} elseif {[
9f00: 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d fblocked $file]}
9f10: 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 65 {..} elseif {[e
9f20: 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 of $file]} {..
9f30: 20 20 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b if {$failed} {
9f40: 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 ...set x {client
9f50: 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 socket was inhe
9f60: 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 20 65 6c rited}.. } el
9f70: 73 65 20 7b 0a 09 09 73 65 74 20 78 20 7b 63 6c se {...set x {cl
9f80: 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 ient socket was
9f90: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 not inherited}..
9fa0: 20 20 20 20 7d 0a 09 20 20 20 20 63 61 74 63 68 }.. catch
9fb0: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
9fc0: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
9fd0: 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c set x {impossibl
9fe0: 65 20 63 61 73 65 7d 0a 09 20 20 20 20 63 61 74 e case}.. cat
9ff0: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
a000: 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e 0a 20 20 }..}..return.
a010: 20 20 7d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 }.. # If th
a020: 65 20 73 6f 63 6b 65 74 20 64 6f 65 73 6e 27 74 e socket doesn't
a030: 20 68 69 74 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 hit end-of-file
a040: 20 69 6e 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 in 5 seconds, t
a050: 68 65 0a 20 20 20 20 23 20 73 63 72 69 70 74 31 he. # script1
a060: 20 70 72 6f 63 65 73 73 20 6d 75 73 74 20 68 61 process must ha
a070: 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 ve inherited the
a080: 20 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 20 73 65 client... se
a090: 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 t failed 0. a
a0a0: 66 74 65 72 20 35 30 30 30 20 5b 6c 69 73 74 20 fter 5000 [list
a0b0: 73 65 74 20 66 61 69 6c 65 64 20 31 5d 0a 0a 20 set failed 1]..
a0c0: 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 # Launch the
a0d0: 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 0a script2 process.
a0e0: 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c . exec $::tcl
a0f0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
a100: 72 69 70 74 32 20 26 0a 0a 20 20 20 20 76 77 61 ript2 &.. vwa
a110: 69 74 20 78 0a 20 20 20 20 69 66 20 7b 21 24 66 it x. if {!$f
a120: 61 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 74 20 ailed} {..vwait
a130: 66 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 20 20 failed. }.
a140: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
a150: 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 pt1. removeFi
a160: 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 le script2. s
a170: 65 74 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 et x.} {client s
a180: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
a190: 68 65 72 69 74 65 64 7d 0a 74 65 73 74 20 73 6f herited}.test so
a1a0: 63 6b 65 74 2d 31 32 2e 33 20 7b 74 65 73 74 69 cket-12.3 {testi
a1b0: 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f ng inheritance o
a1c0: 66 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 f accepted socke
a1d0: 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 ts} \..{socket d
a1e0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
a1f0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 Server} {. re
a200: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 moveFile script1
a210: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
a220: 73 63 72 69 70 74 32 0a 0a 20 20 20 20 73 65 74 script2.. set
a230: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 f [open script1
a240: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
a250: 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 {..after 10000 e
a260: 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 xit..vwait forev
a270: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
a280: 73 65 20 24 66 0a 0a 20 20 20 20 73 65 74 20 66 se $f.. set f
a290: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 [open script2 w
a2a0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
a2b0: 69 73 74 20 73 65 74 20 74 63 6c 74 65 73 74 20 ist set tcltest
a2c0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
a2d0: 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 est]. puts $f
a2e0: 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 20 5b {..set server [
a2f0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
a300: 76 65 72 20 61 63 63 65 70 74 20 32 39 33 30 5d ver accept 2930]
a310: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 ..proc accept {
a320: 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d file host port }
a330: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 {.. global t
a340: 63 6c 74 65 73 74 0a 09 20 20 20 20 70 75 74 73 cltest.. puts
a350: 20 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61 74 $file {test dat
a360: 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 a on socket}..
a370: 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 exec $::tcltes
a380: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
a390: 74 31 20 26 0a 09 20 20 20 20 61 66 74 65 72 20 t1 &.. after
a3a0: 31 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 76 77 1000 exit..}..vw
a3b0: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
a3c0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
a3d0: 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 # Launch the
a3e0: 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 script2 process
a3f0: 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 and connect to
a400: 69 74 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e it. See how lon
a410: 67 0a 20 20 20 20 23 20 74 68 65 20 73 6f 63 6b g. # the sock
a420: 65 74 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 et stays open..
a430: 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 exec $::tclte
a440: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
a450: 70 74 32 20 26 0a 0a 20 20 20 20 61 66 74 65 72 pt2 &.. after
a460: 20 31 30 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 1000 set ok_to_
a470: 70 72 6f 63 65 65 64 20 31 0a 20 20 20 20 76 77 proceed 1. vw
a480: 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 ait ok_to_procee
a490: 64 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c d.. set f [tl
a4a0: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
a4b0: 30 2e 31 20 32 39 33 30 5d 0a 20 20 20 20 66 63 0.1 2930]. fc
a4c0: 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 62 75 66 onfigure $f -buf
a4d0: 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f fering full -blo
a4e0: 63 6b 69 6e 67 20 30 0a 20 20 20 20 66 69 6c 65 cking 0. file
a4f0: 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 62 6c event $f readabl
a500: 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 e [list getdata
a510: 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 $f].. # If th
a520: 65 20 73 6f 63 6b 65 74 20 69 73 20 73 74 69 6c e socket is stil
a530: 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 35 20 73 l open after 5 s
a540: 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 72 69 econds, the scri
a550: 70 74 31 20 70 72 6f 63 65 73 73 0a 20 20 20 20 pt1 process.
a560: 23 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 # must have inhe
a570: 72 69 74 65 64 20 74 68 65 20 61 63 63 65 70 74 rited the accept
a580: 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 ed socket...
a590: 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 set failed 0.
a5a0: 20 61 66 74 65 72 20 35 30 30 30 20 73 65 74 20 after 5000 set
a5b0: 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 70 72 failed 1.. pr
a5c0: 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 6c oc getdata { fil
a5d0: 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 e } {...# Read h
a5e0: 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 63 6c andler on the cl
a5f0: 69 65 6e 74 20 73 6f 63 6b 65 74 2e 0a 09 67 6c ient socket...gl
a600: 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 obal x..global f
a610: 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 74 75 ailed..set statu
a620: 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 s [catch {read $
a630: 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 file} data]..if
a640: 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d 20 7b {$status != 0} {
a650: 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 65 61 .. set x {rea
a660: 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 d failed, error
a670: 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 20 20 was $data}..
a680: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
a690: 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 ile }..} elseif
a6a0: 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 {[string compare
a6b0: 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d {} $data]} {..}
a6c0: 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b elseif {[fblock
a6d0: 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 ed $file]} {..}
a6e0: 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 elseif {[eof $fi
a6f0: 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b le]} {.. if {
a700: 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 $failed} {...set
a710: 20 78 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 x {accepted soc
a720: 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 ket was inherite
a730: 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b d}.. } else {
a740: 0a 09 09 73 65 74 20 78 20 7b 61 63 63 65 70 74 ...set x {accept
a750: 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f ed socket was no
a760: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 t inherited}..
a770: 20 20 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b }.. catch {
a780: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
a790: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 } else {.. se
a7a0: 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 t x {impossible
a7b0: 63 61 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 case}.. catch
a7c0: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
a7d0: 0a 09 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 ..}..return.
a7e0: 7d 0a 20 20 20 20 0a 20 20 20 20 76 77 61 69 74 }. . vwait
a7f0: 20 78 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 x.. removeFi
a800: 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 le script1. r
a810: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
a820: 32 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 2. set x.} {a
a830: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 ccepted socket w
a840: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
a850: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 }..test socket-1
a860: 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 75 73 65 3.1 {Testing use
a870: 20 6f 66 20 73 68 61 72 65 64 20 73 6f 63 6b 65 of shared socke
a880: 74 20 62 65 74 77 65 65 6e 20 74 77 6f 20 74 68 t between two th
a890: 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 reads} \..{socke
a8a0: 74 20 74 65 73 74 74 68 72 65 61 64 7d 20 7b 0a t testthread} {.
a8b0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
a8c0: 73 63 72 69 70 74 0a 20 20 20 20 74 68 72 65 61 script. threa
a8d0: 64 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b 65 46 dReap.. makeF
a8e0: 69 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 ile {. .packa
a8f0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
a900: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
a910: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
a920: 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 t 2828]..proc ac
a930: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 cept {s a p} {.
a940: 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 filee
a950: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
a960: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
a970: 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e fcon
a980: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
a990: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 ring line.
a9a0: 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b }..proc echo {
a9b0: 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 s} {.. globa
a9c0: 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 l i.
a9d0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
a9e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 . if
a9f0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
aa00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 g
aa10: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
aa20: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
aa30: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
aa40: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
aa50: 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 } els
aa60: 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 e { .. i
aa70: 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 ncr i.
aa80: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 puts $s $
aa90: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d l. }
aaa0: 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 77 ..}..set i 0..vw
aab0: 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a ait x..close $f.
aac0: 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 61 6e ..# thread clean
aad0: 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 s itself up...te
aae0: 73 74 74 68 72 65 61 64 20 65 78 69 74 0a 20 20 stthread exit.
aaf0: 20 20 7d 20 73 63 72 69 70 74 0a 20 20 20 20 0a } script. .
ab00: 20 20 20 20 23 20 63 72 65 61 74 65 20 61 20 74 # create a t
ab10: 68 72 65 61 64 0a 20 20 20 20 73 65 74 20 73 65 hread. set se
ab20: 72 76 65 72 74 68 72 65 61 64 20 5b 74 65 73 74 rverthread [test
ab30: 74 68 72 65 61 64 20 63 72 65 61 74 65 20 7b 20 thread create {
ab40: 73 6f 75 72 63 65 20 73 63 72 69 70 74 20 7d 20 source script }
ab50: 5d 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 ]. update.
ab60: 20 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 . after 1000
ab70: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
ab80: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
ab90: 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 2828]. fcon
aba0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
abb0: 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 ring line.. c
abc0: 61 74 63 68 20 7b 0a 09 70 75 74 73 20 24 73 20 atch {..puts $s
abd0: 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 "hello"..gets $s
abe0: 20 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 result. }.
abf0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 close $s. u
ac00: 70 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 72 pdate.. after
ac10: 20 32 30 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 2000. lappen
ac20: 64 20 72 65 73 75 6c 74 20 5b 74 68 72 65 61 64 d result [thread
ac30: 52 65 61 70 5d 0a 20 20 20 20 0a 20 20 20 20 73 Reap]. . s
ac40: 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 et result..} {he
ac50: 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c 65 61 6e 75 llo 1}..# cleanu
ac60: 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 p.if {[string ma
ac70: 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 tch sock* $comma
ac80: 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 ndSocket] == 1}
ac90: 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 6d 6d 61 {. puts $comma
aca0: 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 0a 20 20 ndSocket exit.
acb0: 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 6e 64 53 flush $commandS
acc0: 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 20 7b 63 ocket.}.catch {c
acd0: 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 lose $commandSoc
ace0: 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 ket}.catch {clos
acf0: 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 e $remoteProcCha
ad00: 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 6c n}.::tcltest::cl
ad10: 65 61 6e 75 70 54 65 73 74 73 0a 66 6c 75 73 68 eanupTests.flush
ad20: 20 73 74 64 6f 75 74 0a 72 65 74 75 72 6e 0a 0a stdout.return..
ad30: 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a ..........