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 34 20 32 30 30 30 2f test,v 1.4 2000/
0210: 30 36 2f 30 32 20 32 31 3a 34 34 3a 35 39 20 61 06/02 21:44:59 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 20 70 63 43 72 61 73 ket stdio pcCras
2b40: 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 h} {. removeF
2b50: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
2b60: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
2b70: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
2b80: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
2b90: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
2ba0: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
2bb0: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 set x done"].
2bc0: 20 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a set f [tls:
2bd0: 3a 73 6f 63 6b 65 74 20 20 2d 73 65 72 76 65 72 :socket -server
2be0: 20 61 63 63 65 70 74 20 32 38 33 30 5d 0a 09 70 accept 2830]..p
2bf0: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
2c00: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
2c10: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
2c20: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
2c30: 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 uts "[gets $file
2c40: 5d 20 24 61 64 64 72 22 0a 20 20 20 20 20 20 20 ] $addr".
2c50: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 close $file
2c60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
2c70: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
2c80: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
2c90: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
2ca0: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
2cb0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2cc0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2cd0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2ce0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2cf0: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2d00: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
2d10: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2d20: 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 32 37 2e ket -myaddr 127.
2d30: 30 2e 30 2e 31 20 31 32 37 2e 30 2e 30 2e 31 20 0.0.1 127.0.0.1
2d40: 32 38 33 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 2830} sock]} {.
2d50: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f set x $so
2d60: 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ck. } else {.
2d70: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
2d80: 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 74 63 68 20 ck hello..catch
2d90: 7b 66 6c 75 73 68 20 24 73 6f 63 6b 7d 0a 20 20 {flush $sock}.
2da0: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
2db0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
2dc0: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
2dd0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
2de0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
2df0: 61 64 79 20 7b 68 65 6c 6c 6f 20 31 32 37 2e 30 ady {hello 127.0
2e00: 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 .0.1}}..test soc
2e10: 6b 65 74 2d 32 2e 34 20 7b 74 63 70 20 63 6f 6e ket-2.4 {tcp con
2e20: 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 73 65 72 nection with ser
2e30: 76 65 72 20 69 6e 74 65 72 66 61 63 65 20 73 70 ver interface sp
2e40: 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 ecified} {socket
2e50: 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 stdio pcCrash}
2e60: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
2e70: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
2e80: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
2e90: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
2ea0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
2eb0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
2ec0: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
2ed0: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 20 20 x done"].
2ee0: 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f set f [tls::so
2ef0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
2f00: 65 70 74 20 2d 6d 79 61 64 64 72 20 5b 69 6e 66 ept -myaddr [inf
2f10: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 o hostname] 2831
2f20: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
2f30: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
2f40: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
2f50: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
2f60: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
2f70: 66 69 6c 65 5d 22 0a 20 20 20 20 20 20 20 20 20 file]".
2f80: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 close $file.
2f90: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
2fa0: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
2fb0: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
2fc0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
2fd0: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 er..close $f.
2fe0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
2ff0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3000: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
3010: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
3020: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
3030: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
3040: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
3050: 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 t [info hostname
3060: 5d 20 32 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b ] 2831} sock]} {
3070: 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 . set x $
3080: 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 sock. } else
3090: 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 {. puts $
30a0: 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 sock hello..flus
30b0: 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 h $sock.
30c0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
30d0: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
30e0: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
30f0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3100: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 et x.} {ready he
3110: 6c 6c 6f 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 llo}.test socket
3120: 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.5 {tcp connec
3130: 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e 64 tion with redund
3140: 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 7d ant server port}
3150: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 {socket stdio p
3160: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 cCrash} {. re
3170: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
3180: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3190: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
31a0: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
31b0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
31c0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
31d0: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
31e0: 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 66 20 ]. set f
31f0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
3200: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 32 rver accept 2832
3210: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
3220: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
3230: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
3240: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
3250: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
3260: 66 69 6c 65 5d 22 0a 20 20 20 20 20 20 20 20 20 file]".
3270: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 close $file.
3280: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
3290: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
32a0: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
32b0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
32c0: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 er..close $f.
32d0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
32e0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
32f0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
3300: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
3310: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
3320: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
3330: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
3340: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 32 t 127.0.0.1 2832
3350: 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 } sock]} {.
3360: 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 set x $sock.
3370: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
3380: 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 puts $sock h
3390: 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 ello..flush $soc
33a0: 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e k. lappen
33b0: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
33c0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 close $soc
33d0: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 k. }. clos
33e0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
33f0: 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 {ready hello}.t
3400: 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 36 20 7b est socket-2.6 {
3410: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 tcp connection}
3420: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
3430: 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 et status ok.
3440: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 if {![catch {se
3450: 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f 63 t sock [tls::soc
3460: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
3470: 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 33]}]} {..if {![
3480: 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 6f 63 catch {gets $soc
3490: 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 k}]} {.. set
34a0: 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d status broken..}
34b0: 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 ..close $sock.
34c0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 }. set stat
34d0: 75 73 0a 7d 20 6f 6b 0a 74 65 73 74 20 73 6f 63 us.} ok.test soc
34e0: 6b 65 74 2d 32 2e 37 20 7b 65 63 68 6f 20 73 65 ket-2.7 {echo se
34f0: 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 rver, one line}
3500: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 {socket stdio pc
3510: 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d Crash} {. rem
3520: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
3530: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3540: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3550: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
3560: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
3570: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
3580: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
3590: 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f ..set f [tls::so
35a0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
35b0: 65 70 74 20 32 38 33 34 5d 0a 09 70 72 6f 63 20 ept 2834]..proc
35c0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
35d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
35e0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
35f0: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
3600: 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ].. fconfigur
3610: 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $s -translatio
3620: 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 n lf -buffering
3630: 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 line. }..
3640: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
3650: 09 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 . set l [get
3660: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 s $s].
3670: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
3680: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
3690: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
36a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c cl
36b0: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
36c0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
36d0: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ne.
36e0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
36f0: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
3700: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
3710: 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 }..}..puts rea
3720: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3730: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3740: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
3750: 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 done. }.
3760: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3770: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
3780: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
3790: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
37a0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
37b0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
37c0: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
37d0: 33 34 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 34]. fconfigu
37e0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
37f0: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
3800: 6f 6e 20 6c 66 0a 20 20 20 20 70 75 74 73 20 24 on lf. puts $
3810: 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 s "hello abcdefg
3820: 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 hijklmnop". a
3830: 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 fter 1000. se
3840: 74 20 78 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t x [gets $s].
3850: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
3860: 65 74 20 79 20 5b 67 65 74 73 20 24 66 5d 0a 20 et y [gets $f].
3870: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3880: 6c 69 73 74 20 24 78 20 24 79 0a 7d 20 7b 7b 68 list $x $y.} {{h
3890: 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b ello abcdefghijk
38a0: 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 65 lmnop} done}..te
38b0: 73 74 20 73 6f 63 6b 65 74 2d 32 2e 38 20 7b 65 st socket-2.8 {e
38c0: 63 68 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f 70 cho server, loop
38d0: 20 35 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 6c 50 times, singl
38e0: 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 e connection} {s
38f0: 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 ocket stdio pcCr
3900: 61 73 68 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 ash} {. makeF
3910: 69 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 ile {. .packa
3920: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
3930: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
3940: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3950: 74 20 32 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 t 2835]..proc ac
3960: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 cept {s a p} {.
3970: 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 filee
3980: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
3990: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
39a0: 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e fcon
39b0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
39c0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 ring line.
39d0: 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b }..proc echo {
39e0: 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 s} {.. globa
39f0: 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 l i.
3a00: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
3a10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 . if
3a20: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
3a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 g
3a40: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
3a50: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
3a60: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
3a70: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
3a80: 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 } els
3a90: 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 e { .. i
3aa0: 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 ncr i.
3ab0: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 puts $s $
3ac0: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d l. }
3ad0: 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 75 ..}..set i 0..pu
3ae0: 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 ts ready..set ti
3af0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 mer [after 20000
3b00: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 "set x done"]..
3b10: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
3b20: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
3b30: 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 64 6f ose $f..puts "do
3b40: 6e 65 20 24 69 22 0a 20 20 20 20 7d 20 73 63 72 ne $i". } scr
3b50: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
3b60: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
3b70: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
3b80: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
3b90: 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 gets $f. set
3ba0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 s [tls::socket 1
3bb0: 32 37 2e 30 2e 30 2e 31 20 32 38 33 35 5d 0a 20 27.0.0.1 2835].
3bc0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
3bd0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
3be0: 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 66 6f . catch {..fo
3bf0: 72 20 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 20 r {set x 0} {$x
3c00: 3c 20 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b < 50} {incr x} {
3c10: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 22 68 .. puts $s "h
3c20: 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b ello abcdefghijk
3c30: 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 73 lmnop".. gets
3c40: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
3c50: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 61 close $s. ca
3c60: 74 63 68 20 7b 73 65 74 20 78 20 5b 67 65 74 73 tch {set x [gets
3c70: 20 24 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 $f]}. close
3c80: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
3c90: 64 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 73 done 50}..test s
3ca0: 6f 63 6b 65 74 2d 32 2e 39 20 7b 73 6f 63 6b 65 ocket-2.9 {socke
3cb0: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 t conflict} {soc
3cc0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3cd0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
3ce0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
3cf0: 70 74 20 32 38 32 38 5d 0a 20 20 20 20 72 65 6d pt 2828]. rem
3d00: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
3d10: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3d20: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3d30: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 s -nonewline $f
3d40: 7b 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 {package require
3d50: 20 74 6c 73 3b 20 74 6c 73 3a 3a 73 6f 63 6b 65 tls; tls::socke
3d60: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3d70: 20 32 38 32 38 7d 0a 20 20 20 20 63 6c 6f 73 65 2828}. close
3d80: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
3d90: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
3da0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
3db0: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
3dc0: 67 65 74 73 20 24 66 0a 20 20 20 20 61 66 74 65 gets $f. afte
3dd0: 72 20 31 30 30 0a 20 20 20 20 73 65 74 20 78 20 r 100. set x
3de0: 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 63 6c [list [catch {cl
3df0: 6f 73 65 20 24 66 7d 20 6d 73 67 5d 20 24 6d 73 ose $f} msg] $ms
3e00: 67 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a g]. close $s.
3e10: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b set x.} {1 {
3e20: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
3e30: 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c cket: address al
3e40: 72 65 61 64 79 20 69 6e 20 75 73 65 0a 20 20 20 ready in use.
3e50: 20 77 68 69 6c 65 20 65 78 65 63 75 74 69 6e 67 while executing
3e60: 0a 22 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ."::socket -serv
3e70: 65 72 20 7b 74 6c 73 3a 3a 5f 61 63 63 65 70 74 er {tls::_accept
3e80: 20 7b 2d 73 65 72 76 65 72 20 31 7d 20 61 63 63 {-server 1} acc
3e90: 65 70 74 7d 20 32 38 32 38 22 0a 20 20 20 20 28 ept} 2828". (
3ea0: 22 65 76 61 6c 22 20 62 6f 64 79 20 6c 69 6e 65 "eval" body line
3eb0: 20 31 29 0a 20 20 20 20 69 6e 76 6f 6b 65 64 20 1). invoked
3ec0: 66 72 6f 6d 20 77 69 74 68 69 6e 0a 22 65 76 61 from within."eva
3ed0: 6c 20 3a 3a 73 6f 63 6b 65 74 20 24 73 6f 70 74 l ::socket $sopt
3ee0: 73 22 0a 20 20 20 20 28 70 72 6f 63 65 64 75 72 s". (procedur
3ef0: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 22 20 e "tls::socket"
3f00: 6c 69 6e 65 20 36 32 29 0a 20 20 20 20 69 6e 76 line 62). inv
3f10: 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 68 69 6e oked from within
3f20: 0a 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 ."tls::socket -s
3f30: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
3f40: 38 22 0a 20 20 20 20 28 66 69 6c 65 20 22 73 63 8". (file "sc
3f50: 72 69 70 74 22 20 6c 69 6e 65 20 31 29 7d 7d 0a ript" line 1)}}.
3f60: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 31 .test socket-2.1
3f70: 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 63 65 0 {close on acce
3f80: 70 74 2c 20 61 63 63 65 70 74 65 64 20 73 6f 63 pt, accepted soc
3f90: 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73 6f 63 6b ket lives} {sock
3fa0: 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 et pcCrash} {.
3fb0: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
3fc0: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
3fd0: 72 20 32 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 20000 "set don
3fe0: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
3ff0: 20 20 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 set ss [tls::s
4000: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4010: 63 65 70 74 20 32 38 33 30 5d 0a 20 20 20 20 70 cept 2830]. p
4020: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
4030: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a p} {..global ss.
4040: 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 .close $ss..file
4050: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
4060: 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 09 66 e "readit $s"..f
4070: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
4080: 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 ans lf. }.
4090: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
40a0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a {..global done.
40b0: 09 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 .gets $s..close
40c0: 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 $s..set done 1.
40d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 73 20 }. set cs
40e0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e [tls::socket [in
40f0: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 fo hostname] 283
4100: 30 5d 0a 20 20 20 20 70 75 74 73 20 24 63 73 20 0]. puts $cs
4110: 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 20 hello. close
4120: 24 63 73 0a 20 20 20 20 76 77 61 69 74 20 64 6f $cs. vwait do
4130: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
4140: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 cel $timer. s
4150: 65 74 20 64 6f 6e 65 0a 7d 20 31 0a 74 65 73 74 et done.} 1.test
4160: 20 73 6f 63 6b 65 74 2d 32 2e 31 31 20 7b 64 65 socket-2.11 {de
4170: 74 65 63 74 69 6e 67 20 6e 65 77 20 64 61 74 61 tecting new data
4180: 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 } {socket pcCras
4190: 68 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 h} {. proc ac
41a0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
41b0: 67 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 73 65 74 global sock..set
41c0: 20 73 6f 63 6b 20 24 73 0a 20 20 20 20 7d 0a 0a sock $s. }..
41d0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
41e0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
41f0: 63 63 65 70 74 20 32 34 30 30 5d 0a 20 20 20 20 ccept 2400].
4200: 73 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 set sock "".
4210: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
4220: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 34 ket 127.0.0.1 24
4230: 30 30 5d 0a 20 20 20 20 76 77 61 69 74 20 73 6f 00]. vwait so
4240: 63 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 ck. puts $s2
4250: 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 one. flush $s
4260: 32 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0a 2. after 500.
4270: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
4280: 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 sock -blocking 0
4290: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 20 . set result
42a0: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
42b0: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
42c0: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
42d0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
42e0: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 k -blocking 1.
42f0: 20 20 70 75 74 73 20 24 73 32 20 74 77 6f 0a 20 puts $s2 two.
4300: 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 flush $s2.
4310: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
4320: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 k -blocking 0.
4330: 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 lappend result
4340: 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 [gets $sock].
4350: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
4360: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 ck -blocking 1.
4370: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
4380: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
4390: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 ose $sock. se
43a0: 74 20 72 65 73 75 6c 74 0a 7d 20 7b 6f 6e 65 20 t result.} {one
43b0: 7b 7d 20 74 77 6f 7d 0a 0a 0a 74 65 73 74 20 73 {} two}...test s
43c0: 6f 63 6b 65 74 2d 33 2e 31 20 7b 73 6f 63 6b 65 ocket-3.1 {socke
43d0: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 t conflict} {soc
43e0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
43f0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
4400: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
4410: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
4420: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
4430: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
4440: 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a tls..set f [tls:
4450: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4460: 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 70 75 accept 2828]..pu
4470: 74 73 20 72 65 61 64 79 0a 09 67 65 74 73 20 73 ts ready..gets s
4480: 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a 20 tdin..close $f.
4490: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
44a0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
44b0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
44c0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
44d0: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 67 ript]" r+]. g
44e0: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 78 ets $f. set x
44f0: 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 [list [catch {t
4500: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4510: 65 72 20 61 63 63 65 70 74 20 32 38 32 38 7d 20 er accept 2828}
4520: 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 msg] \...$msg].
4530: 20 20 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 puts $f bye.
4540: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4550: 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c set x.} {1 {coul
4560: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
4570: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
4580: 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 y in use}}..test
4590: 20 73 6f 63 6b 65 74 2d 33 2e 32 20 7b 73 65 72 socket-3.2 {ser
45a0: 76 65 72 20 77 69 74 68 20 73 65 76 65 72 61 6c ver with several
45b0: 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 clients} {socke
45c0: 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d t stdio pcCrash}
45d0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
45e0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
45f0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
4600: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
4610: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
4620: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
4630: 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 1 [after 30000 "
4640: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
4650: 5d 0a 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 ]..set t2 [after
4660: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
4670: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 med_out"]..set t
4680: 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 3 [after 32000 "
4690: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
46a0: 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 ]..set counter 0
46b0: 0a 09 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f ..set s [tls::so
46c0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
46d0: 65 70 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 ept 2828]..proc
46e0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
46f0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
4700: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
4710: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
4720: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
4730: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d uffering line..}
4740: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
4750: 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 {.. global x
4760: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 . se
4770: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
4780: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
4790: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
47a0: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
47b0: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
47c0: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
47d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 . }
47e0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 else {.
47f0: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
4800: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
4810: 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 }..}..puts ready
4820: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
4830: 20 63 61 6e 63 65 6c 20 24 74 31 0a 09 76 77 61 cancel $t1..vwa
4840: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
4850: 65 6c 20 24 74 32 0a 09 76 77 61 69 74 20 78 0a el $t2..vwait x.
4860: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
4870: 33 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 3..close $s..put
4880: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
4890: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
48a0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
48b0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
48c0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
48d0: 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 . set x [gets
48e0: 20 24 66 5d 0a 20 20 20 20 73 65 74 20 73 31 20 $f]. set s1
48f0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
4900: 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 .0.0.1 2828].
4910: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 fconfigure $s1
4920: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4930: 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a set s2 [tls:
4940: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
4950: 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 2828]. fcon
4960: 66 69 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 figure $s2 -buff
4970: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
4980: 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s3 [tls::sock
4990: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 et 127.0.0.1 282
49a0: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
49b0: 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 e $s3 -buffering
49c0: 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 line. for {s
49d0: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 et i 0} {$i < 10
49e0: 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 0} {incr i} {..p
49f0: 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 uts $s1 hello,s1
4a00: 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 ..gets $s1..puts
4a10: 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 $s2 hello,s2..g
4a20: 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 ets $s2..puts $s
4a30: 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 3 hello,s3..gets
4a40: 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 $s3. }. c
4a50: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f lose $s1. clo
4a60: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
4a70: 20 24 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 $s3. lappend
4a80: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
4a90: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4aa0: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e t x.} {ready don
4ab0: 65 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d e}..test socket-
4ac0: 34 2e 31 20 7b 73 65 72 76 65 72 20 77 69 74 68 4.1 {server with
4ad0: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
4ae0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 } {socket stdio
4af0: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 pcCrash} {. r
4b00: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
4b10: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4b20: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
4b30: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
4b40: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
4b50: 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 73 s..gets stdin..s
4b60: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
4b70: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 t 127.0.0.1 2828
4b80: 5d 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 ]..fconfigure $s
4b90: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
4ba0: 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 ..for {set i 0}
4bb0: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
4bc0: 20 69 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 i} {.. puts
4bd0: 24 73 20 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 $s hello.. ge
4be0: 74 73 20 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 ts $s..}..close
4bf0: 24 73 0a 09 70 75 74 73 20 62 79 65 0a 09 67 65 $s..puts bye..ge
4c00: 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 ts stdin. }.
4c10: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4c20: 73 65 74 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b set p1 [open "|[
4c30: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
4c40: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
4c50: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
4c60: 67 75 72 65 20 24 70 31 20 2d 62 75 66 66 65 72 gure $p1 -buffer
4c70: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
4c80: 20 70 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 p2 [open "|[lis
4c90: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
4ca0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
4cb0: 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 +]. fconfigur
4cc0: 65 20 24 70 32 20 2d 62 75 66 66 65 72 69 6e 67 e $p2 -buffering
4cd0: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 33 line. set p3
4ce0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
4cf0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
4d00: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
4d10: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
4d20: 70 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p3 -buffering li
4d30: 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 ne. proc acce
4d40: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
4d50: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
4d60: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c fering line..fil
4d70: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
4d80: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
4d90: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 ]. }. proc
4da0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f echo {s} {..glo
4db0: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 73 65 bal x. se
4dc0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
4dd0: 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 if {[eof $
4de0: 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 s]} {.
4df0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
4e00: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
4e10: 65 0a 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 e. } else
4e20: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 {. p
4e30: 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 uts $s $l.
4e40: 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 }. }. se
4e50: 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 t t1 [after 3000
4e60: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
4e70: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 32 20 ut"]. set t2
4e80: 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 [after 31000 "se
4e90: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
4ea0: 20 20 20 20 73 65 74 20 74 33 20 5b 61 66 74 65 set t3 [afte
4eb0: 72 20 33 32 30 30 30 20 22 73 65 74 20 78 20 74 r 32000 "set x t
4ec0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
4ed0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
4ee0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
4ef0: 20 32 38 32 38 5d 0a 20 20 20 20 70 75 74 73 20 2828]. puts
4f00: 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 $p1 open. put
4f10: 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 s $p2 open. p
4f20: 75 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 uts $p3 open.
4f30: 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 vwait x. vwa
4f40: 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 it x. vwait x
4f50: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
4f60: 6c 20 24 74 31 0a 20 20 20 20 61 66 74 65 72 20 l $t1. after
4f70: 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 61 cancel $t2. a
4f80: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a fter cancel $t3.
4f90: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
4fa0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
4fb0: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 ppend l [list p1
4fc0: 20 5b 67 65 74 73 20 24 70 31 5d 20 24 78 5d 0a [gets $p1] $x].
4fd0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
4fe0: 69 73 74 20 70 32 20 5b 67 65 74 73 20 24 70 32 ist p2 [gets $p2
4ff0: 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e ] $x]. lappen
5000: 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 d l [list p3 [ge
5010: 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 ts $p3] $x].
5020: 70 75 74 73 20 24 70 31 20 62 79 65 0a 20 20 20 puts $p1 bye.
5030: 20 70 75 74 73 20 24 70 32 20 62 79 65 0a 20 20 puts $p2 bye.
5040: 20 20 70 75 74 73 20 24 70 33 20 62 79 65 0a 20 puts $p3 bye.
5050: 20 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 close $p1.
5060: 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 63 close $p2. c
5070: 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 73 65 74 lose $p3. set
5080: 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 6f l.} {{p1 bye do
5090: 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e 65 ne} {p2 bye done
50a0: 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d 7d } {p3 bye done}}
50b0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 34 2e ..test socket-4.
50c0: 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 2 {byte order pr
50d0: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
50e0: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b umbers, htons} {
50f0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
5100: 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b t x ok. if {[
5110: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
5120: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
5130: 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 0x3000} msg]} {.
5140: 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 .set x $msg.
5150: 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 } else {..close
5160: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
5170: 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 et x.} ok..test
5180: 73 6f 63 6b 65 74 2d 35 2e 31 20 7b 62 79 74 65 socket-5.1 {byte
5190: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
51a0: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
51b0: 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b htons} \..{sock
51c0: 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 et unixOnly notR
51d0: 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 oot} {. set x
51e0: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
51f0: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
5200: 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 r}. if {![cat
5210: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
5220: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 -server dodo 0x1
5230: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
5240: 20 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 set x {htons p
5250: 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 roblem, should b
5260: 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 e disallowed, ar
5270: 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 e you running as
5280: 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 SU?}..close $ms
5290: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
52a0: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
52b0: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
52c0: 77 6e 65 72 7d 0a 74 65 73 74 20 73 6f 63 6b 65 wner}.test socke
52d0: 74 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 t-5.2 {byte orde
52e0: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
52f0: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
5300: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
5310: 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 set x {couldn'
5320: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
5330: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
5340: 69 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 igh}. if {![c
5350: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
5360: 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 t -server dodo 0
5370: 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a x10000} msg]} {.
5380: 09 73 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 .set x {port res
5390: 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c olution problem,
53a0: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
53b0: 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d lowed}..close $m
53c0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
53d0: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
53e0: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 pen socket: port
53f0: 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 number too high
5400: 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 35 2e }.test socket-5.
5410: 33 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 3 {byte order pr
5420: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
5430: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c umbers, htons} \
5440: 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e ..{socket unixOn
5450: 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 ly notRoot} {.
5460: 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 set x {couldn'
5470: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e t open socket: n
5480: 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 ot owner}. if
5490: 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a {![catch {tls::
54a0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 socket -server d
54b0: 6f 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a odo 21} msg]} {.
54c0: 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 .set x {htons pr
54d0: 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 oblem, should be
54e0: 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 disallowed, are
54f0: 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 you running as
5500: 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 SU?}..close $msg
5510: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
5520: 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 .} {couldn't ope
5530: 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 n socket: not ow
5540: 6e 65 72 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 ner}..test socke
5550: 74 2d 36 2e 31 20 7b 61 63 63 65 70 74 20 63 61 t-6.1 {accept ca
5560: 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 llback error} {s
5570: 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 ocket stdio pcCr
5580: 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ash} {. remov
5590: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
55a0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
55b0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
55c0: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
55d0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 e require tls..g
55e0: 65 74 73 20 73 74 64 69 6e 0a 09 74 6c 73 3a 3a ets stdin..tls::
55f0: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
5600: 20 32 38 34 38 0a 20 20 20 20 7d 0a 20 20 20 20 2848. }.
5610: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5620: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
5630: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
5640: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b test script]" r+
5650: 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 ]. proc bgerr
5660: 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 or args {..globa
5670: 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 l x..set x $args
5680: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
5690: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
56a0: 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 expr 10 / 0}.
56b0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
56c0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
56d0: 70 74 20 32 38 34 38 5d 0a 20 20 20 20 70 75 74 pt 2848]. put
56e0: 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 s $f hello. c
56f0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
5700: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
5710: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5720: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
5730: 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 x. after canc
5740: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
5750: 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d ose $s. renam
5760: 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 e bgerror {}.
5770: 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 set x.} {{divid
5780: 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 e by zero}}..tes
5790: 74 20 73 6f 63 6b 65 74 2d 37 2e 31 20 7b 74 65 t socket-7.1 {te
57a0: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
57b0: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
57c0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 socket stdio pcC
57d0: 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rash} {. remo
57e0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
57f0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
5800: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
5810: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
5820: 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a equire tls..tls:
5830: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
5840: 61 63 63 65 70 74 20 32 38 32 30 0a 09 70 72 6f accept 2820..pro
5850: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
5860: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
5870: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
5880: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
5890: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
58a0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
58b0: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
58c0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
58d0: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
58e0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
58f0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
5900: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
5910: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
5920: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
5930: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
5940: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
5950: 32 30 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 20]. set p [f
5960: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 configure $s -pe
5970: 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ername]. clos
5980: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
5990: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
59a0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
59b0: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 ring compare [li
59c0: 6e 64 65 78 20 24 70 20 30 5d 20 31 32 37 2e 30 ndex $p 0] 127.0
59d0: 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e .0.1]. lappen
59e0: 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 d l [string comp
59f0: 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 are [lindex $p 2
5a00: 5d 20 32 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 ] 2820]. lapp
5a10: 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 end l [llength $
5a20: 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a 74 65 73 p].} {0 0 3}.tes
5a30: 74 20 73 6f 63 6b 65 74 2d 37 2e 32 20 7b 74 65 t socket-7.2 {te
5a40: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
5a50: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
5a60: 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 socket stdio pcC
5a70: 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rash} {. remo
5a80: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
5a90: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
5aa0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
5ab0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
5ac0: 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a equire tls..tls:
5ad0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
5ae0: 61 63 63 65 70 74 20 32 38 32 31 0a 09 70 72 6f accept 2821..pro
5af0: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
5b00: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
5b10: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
5b20: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
5b30: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
5b40: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
5b50: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
5b60: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
5b70: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
5b80: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5b90: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
5ba0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
5bb0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
5bc0: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
5bd0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
5be0: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
5bf0: 32 31 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 21]. set p [f
5c00: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
5c10: 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ckname]. clos
5c20: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
5c30: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
5c40: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c lappend l [ll
5c50: 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 ength $p]. la
5c60: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
5c70: 24 70 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e $p 0]. lappen
5c80: 64 20 6c 20 5b 65 78 70 72 20 5b 6c 69 6e 64 65 d l [expr [linde
5c90: 78 20 24 70 20 32 5d 20 3d 3d 20 32 38 32 31 5d x $p 2] == 2821]
5ca0: 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 .} {3 127.0.0.1
5cb0: 30 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 0}.test socket-7
5cc0: 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .3 {testing sock
5cd0: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
5ce0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ons} {socket} {.
5cf0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
5d00: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
5d10: 63 63 65 70 74 20 32 38 32 32 5d 0a 20 20 20 20 ccept 2822].
5d20: 73 65 74 20 6c 20 5b 66 63 6f 6e 66 69 67 75 72 set l [fconfigur
5d30: 65 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 e $s]. close
5d40: 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 $s. update.
5d50: 20 20 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d 20 31 llength $l.} 1
5d60: 32 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 2.test socket-7.
5d70: 34 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 4 {testing socke
5d80: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
5d90: 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 ns} {socket pcCr
5da0: 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ash} {. set s
5db0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
5dc0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
5dd0: 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 3]. proc acce
5de0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
5df0: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
5e00: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
5e10: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
5e20: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
5e30: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
5e40: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
5e50: 32 38 32 33 5d 0a 20 20 20 20 73 65 74 20 74 69 2823]. set ti
5e60: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
5e70: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
5e80: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
5e90: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
5ea0: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
5eb0: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
5ec0: 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a s1. set l "".
5ed0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
5ee0: 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 index $x 2] [lle
5ef0: 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 32 38 32 33 ngth $x].} {2823
5f00: 20 33 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 3}..test socket
5f10: 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.5 {testing so
5f20: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
5f30: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 75 tions} {socket u
5f40: 6e 69 78 4f 72 50 63 20 70 63 43 72 61 73 68 7d nixOrPc pcCrash}
5f50: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
5f60: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5f70: 72 20 61 63 63 65 70 74 20 32 38 32 39 5d 0a 20 r accept 2829].
5f80: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
5f90: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
5fa0: 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 x..set x [fconf
5fb0: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
5fc0: 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 me]..close $s.
5fd0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b }. set s1 [
5fe0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
5ff0: 30 2e 30 2e 31 20 32 38 32 39 5d 0a 20 20 20 20 0.0.1 2829].
6000: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6010: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6020: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6030: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6040: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6050: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
6060: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
6070: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
6080: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 d l [lindex $x 0
6090: 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 ] [lindex $x 2]
60a0: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
60b0: 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 20 33 127.0.0.1 2829 3
60c0: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 38 }..test socket-8
60d0: 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 .1 {testing -asy
60e0: 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 nc flag on socke
60f0: 74 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 ts} {socket pcCr
6100: 61 73 68 7d 20 7b 0a 20 20 20 20 23 20 4e 4f 54 ash} {. # NOT
6110: 45 3a 20 54 68 69 73 20 74 65 73 74 20 6d 61 79 E: This test may
6120: 20 66 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f fail on some So
6130: 6c 61 72 69 73 20 32 2e 34 20 73 79 73 74 65 6d laris 2.4 system
6140: 73 2e 20 49 66 20 69 74 20 64 6f 65 73 2c 0a 20 s. If it does,.
6150: 20 20 20 23 20 63 68 65 63 6b 20 74 68 61 74 20 # check that
6160: 79 6f 75 20 68 61 76 65 20 74 68 65 73 65 20 70 you have these p
6170: 61 74 63 68 65 73 20 69 6e 73 74 61 6c 6c 65 64 atches installed
6180: 20 28 75 73 69 6e 67 20 73 68 6f 77 72 65 76 20 (using showrev
6190: 2d 70 29 3a 0a 20 20 20 20 23 0a 20 20 20 20 23 -p):. #. #
61a0: 20 31 30 31 39 30 37 2d 30 35 2c 20 31 30 31 39 101907-05, 1019
61b0: 32 35 2d 30 32 2c 20 31 30 31 39 34 35 2d 31 34 25-02, 101945-14
61c0: 2c 20 31 30 31 39 35 39 2d 30 33 2c 20 31 30 31 , 101959-03, 101
61d0: 39 36 39 2d 30 35 2c 20 31 30 31 39 37 33 2d 30 969-05, 101973-0
61e0: 33 2c 0a 20 20 20 20 23 20 31 30 31 39 37 37 2d 3,. # 101977-
61f0: 30 33 2c 20 31 30 31 39 38 31 2d 30 32 2c 20 31 03, 101981-02, 1
6200: 30 31 39 38 35 2d 30 31 2c 20 31 30 32 30 30 31 01985-01, 102001
6210: 2d 30 33 2c 20 31 30 32 30 30 33 2d 30 31 2c 20 -03, 102003-01,
6220: 31 30 32 30 30 37 2d 30 31 2c 0a 20 20 20 20 23 102007-01,. #
6230: 20 31 30 32 30 31 31 2d 30 32 2c 20 31 30 32 30 102011-02, 1020
6240: 32 34 2d 30 31 2c 20 31 30 32 30 33 39 2d 30 31 24-01, 102039-01
6250: 2c 20 31 30 32 30 34 34 2d 30 31 2c 20 31 30 32 , 102044-01, 102
6260: 30 34 38 2d 30 31 2c 20 31 30 32 30 36 32 2d 30 048-01, 102062-0
6270: 33 2c 0a 20 20 20 20 23 20 31 30 32 30 36 36 2d 3,. # 102066-
6280: 30 34 2c 20 31 30 32 30 37 30 2d 30 31 2c 20 31 04, 102070-01, 1
6290: 30 32 31 30 35 2d 30 31 2c 20 31 30 32 31 35 33 02105-01, 102153
62a0: 2d 30 33 2c 20 31 30 32 32 31 36 2d 30 31 2c 20 -03, 102216-01,
62b0: 31 30 32 32 33 32 2d 30 31 2c 0a 20 20 20 20 23 102232-01,. #
62c0: 20 31 30 31 38 37 38 2d 30 33 2c 20 31 30 31 38 101878-03, 1018
62d0: 37 39 2d 30 31 2c 20 31 30 31 38 38 30 2d 30 33 79-01, 101880-03
62e0: 2c 20 31 30 31 39 33 33 2d 30 31 2c 20 31 30 31 , 101933-01, 101
62f0: 39 35 30 2d 30 31 2c 20 31 30 32 30 33 30 2d 30 950-01, 102030-0
6300: 31 2c 0a 20 20 20 20 23 20 31 30 32 30 35 37 2d 1,. # 102057-
6310: 30 38 2c 20 31 30 32 31 34 30 2d 30 31 2c 20 31 08, 102140-01, 1
6320: 30 31 39 32 30 2d 30 32 2c 20 31 30 31 39 32 31 01920-02, 101921
6330: 2d 30 39 2c 20 31 30 31 39 32 32 2d 30 37 2c 20 -09, 101922-07,
6340: 31 30 31 39 32 33 2d 30 33 0a 20 20 20 20 23 0a 101923-03. #.
6350: 20 20 20 20 23 20 49 66 20 61 66 74 65 72 20 69 # If after i
6360: 6e 73 74 61 6c 6c 69 6e 67 20 74 68 65 73 65 20 nstalling these
6370: 70 61 74 63 68 65 73 20 79 6f 75 20 61 72 65 20 patches you are
6380: 73 74 69 6c 6c 20 65 78 70 65 72 69 65 6e 63 69 still experienci
6390: 6e 67 20 61 0a 20 20 20 20 23 20 70 72 6f 62 6c ng a. # probl
63a0: 65 6d 2c 20 70 6c 65 61 73 65 20 65 6d 61 69 6c em, please email
63b0: 20 6a 79 6c 40 65 6e 67 2e 73 75 6e 2e 63 6f 6d jyl@eng.sun.com
63c0: 2e 20 57 65 20 68 61 76 65 20 6e 6f 74 20 6f 62 . We have not ob
63d0: 73 65 72 76 65 64 20 74 68 69 73 0a 20 20 20 20 served this.
63e0: 23 20 66 61 69 6c 75 72 65 20 6f 6e 20 53 6f 6c # failure on Sol
63f0: 61 72 69 73 20 32 2e 35 2c 20 73 6f 20 61 6e 6f aris 2.5, so ano
6400: 74 68 65 72 20 6f 70 74 69 6f 6e 20 28 69 6e 73 ther option (ins
6410: 74 65 61 64 20 6f 66 20 69 6e 73 74 61 6c 6c 69 tead of installi
6420: 6e 67 0a 20 20 20 20 23 20 74 68 65 73 65 20 70 ng. # these p
6430: 61 74 63 68 65 73 29 20 69 73 20 74 6f 20 75 70 atches) is to up
6440: 67 72 61 64 65 20 74 6f 20 53 6f 6c 61 72 69 73 grade to Solaris
6450: 20 32 2e 35 2e 0a 20 20 20 20 73 65 74 20 73 20 2.5.. set s
6460: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
6470: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 30 rver accept 2830
6480: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
6490: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
64a0: 62 61 6c 20 78 0a 09 70 75 74 73 20 24 73 20 62 bal x..puts $s b
64b0: 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 ye..close $s..se
64c0: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 t x done. }.
64d0: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
64e0: 73 6f 63 6b 65 74 20 2d 61 73 79 6e 63 20 5b 69 socket -async [i
64f0: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 nfo hostname] 28
6500: 33 30 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 30]. vwait x.
6510: 20 20 20 20 73 65 74 20 7a 20 5b 67 65 74 73 20 set z [gets
6520: 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s1]. close $
6530: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a s. close $s1.
6540: 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a set z.} bye.
6550: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 39 2e 31 .test socket-9.1
6560: 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f {testing spurio
6570: 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b us events} {sock
6580: 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 et pcCrash} {.
6590: 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 set len 0.
65a0: 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 set spurious 0.
65b0: 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 set done 0.
65c0: 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c proc readlittl
65d0: 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 e {s} {..global
65e0: 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 spurious done le
65f0: 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 n..set l [read $
6600: 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e s 1]..if {[strin
6610: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 g length $l] ==
6620: 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 0} {.. if {![
6630: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 eof $s]} {...inc
6640: 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 r spurious..
6650: 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 } else {...close
6660: 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 $s...set done 1
6670: 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 .. }..} else
6680: 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 {.. incr len
6690: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
66a0: 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 l]..}. }.
66b0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
66c0: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
66d0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
66e0: 6e 6f 6e 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f none -blocking o
66f0: 66 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 ff..fileevent $s
6700: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
6710: 72 65 61 64 6c 69 74 74 6c 65 20 24 73 5d 0a 20 readlittle $s].
6720: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
6730: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6740: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 31 5d ver accept 2831]
6750: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
6760: 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f :socket [info ho
6770: 73 74 6e 61 6d 65 5d 20 32 38 33 31 5d 0a 20 20 stname] 2831].
6780: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
6790: 65 20 24 63 20 30 31 32 33 34 35 36 37 38 39 30 e $c 01234567890
67a0: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
67b0: 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 7890123456789012
67c0: 33 34 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 73 3456789. clos
67d0: 65 20 24 63 0a 20 20 20 20 73 65 74 20 74 69 6d e $c. set tim
67e0: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
67f0: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
6800: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
6810: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
6820: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
6830: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 close $s. li
6840: 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 st $spurious $le
6850: 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 n.} {0 50}..test
6860: 20 73 6f 63 6b 65 74 2d 39 2e 32 20 7b 74 65 73 socket-9.2 {tes
6870: 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 ting async write
6880: 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c , fileevents, fl
6890: 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 ush on close} {s
68a0: 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b ocket pcCrash} {
68b0: 0a 20 20 20 20 73 65 74 20 66 69 72 73 74 62 6c . set firstbl
68c0: 6f 63 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 7b ock "". for {
68d0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 set i 0} {$i < 5
68e0: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 73 65 74 20 } {incr i} {set
68f0: 66 69 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 69 firstblock "a$fi
6900: 72 73 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 6c rstblock$firstbl
6910: 6f 63 6b 22 7d 0a 20 20 20 20 73 65 74 20 73 65 ock"}. set se
6920: 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a 20 20 20 condblock "".
6930: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
6940: 24 69 20 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 $i < 16} {incr i
6950: 7d 20 7b 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 } {..set secondb
6960: 6c 6f 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 6c lock "b$secondbl
6970: 6f 63 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 ock$secondblock"
6980: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c . }. set l
6990: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
69a0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
69b0: 32 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 2]. proc acce
69c0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
69d0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f onfigure $s -blo
69e0: 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 cking 0 -transla
69f0: 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 tion lf -buffers
6a00: 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 ize 16384 \...-b
6a10: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 uffering line..f
6a20: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
6a30: 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 able "readable $
6a40: 73 22 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f s". }. pro
6a50: 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b c readable {s} {
6a60: 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 ..set l [gets $s
6a70: 5d 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 ]..fileevent $s
6a80: 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 readable {}..aft
6a90: 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 er 1000 respond
6aa0: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f $s. }. pro
6ab0: 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a c respond {s} {.
6ac0: 09 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f .global firstblo
6ad0: 63 6b 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c ck..puts -nonewl
6ae0: 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f ine $s $firstblo
6af0: 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 ck..after 1000 w
6b00: 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 ritedata $s.
6b10: 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 }. proc write
6b20: 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 data {s} {..glob
6b30: 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 al secondblock..
6b40: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
6b50: 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a $s $secondblock.
6b60: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
6b70: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6b80: 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 socket [info hos
6b90: 74 6e 61 6d 65 5d 20 32 38 33 32 5d 0a 20 20 20 tname] 2832].
6ba0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
6bb0: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
6bc0: 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 s lf -buffering
6bd0: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 line. set cou
6be0: 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 nt 0. puts $s
6bf0: 20 68 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 hello. proc
6c00: 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c readit {s} {..gl
6c10: 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a obal count done.
6c20: 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d .set l [read $s]
6c30: 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 ..incr count [st
6c40: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
6c50: 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b .if {[eof $s]} {
6c60: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
6c70: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 set done 1..
6c80: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 }. }. file
6c90: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
6ca0: 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 e "readit $s".
6cb0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
6cc0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f er 10000 "set do
6cd0: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 ne timed_out"].
6ce0: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
6cf0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
6d00: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
6d10: 24 6c 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 $l. set count
6d20: 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 73 .} 65566..test s
6d30: 6f 63 6b 65 74 2d 39 2e 33 20 7b 74 65 73 74 69 ocket-9.3 {testi
6d40: 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 ng EOF stickynes
6d50: 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 s} {socket pcCra
6d60: 73 68 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 63 sh} {. proc c
6d70: 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 ount_to_eof {s}
6d80: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 {..global count
6d90: 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 20 done timer..set
6da0: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 l [gets $s]..if
6db0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
6dc0: 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 incr count..
6dd0: 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 if {$count > 9
6de0: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
6df0: 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 .set done true..
6e00: 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 .set count {eof
6e10: 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 is sticky}...aft
6e20: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
6e30: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
6e40: 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 72 70 . proc timerp
6e50: 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c roc {} {..global
6e60: 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 done count c..s
6e70: 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 et done true..se
6e80: 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 t count {timer w
6e90: 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 ent off, eof is
6ea0: 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f not sticky}..clo
6eb0: 73 65 20 24 63 0a 20 20 20 20 7d 09 0a 20 20 20 se $c. }..
6ec0: 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 set count 0.
6ed0: 20 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a set done false.
6ee0: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 5f 74 proc write_t
6ef0: 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a hen_close {s} {.
6f00: 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c .puts $s bye..cl
6f10: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
6f20: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
6f30: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
6f40: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
6f50: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
6f60: 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e 74 on lf..fileevent
6f70: 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 77 72 $s writable "wr
6f80: 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 24 ite_then_close $
6f90: 73 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s". }. set
6fa0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
6fb0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
6fc0: 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 833]. set c [
6fd0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 tls::socket [inf
6fe0: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 33 o hostname] 2833
6ff0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
7000: 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 $c -blocking of
7010: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
7020: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c e -translation l
7030: 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 f. fileevent
7040: 24 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 $c readable "cou
7050: 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 20 nt_to_eof $c".
7060: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
7070: 65 72 20 31 30 30 30 20 74 69 6d 65 72 70 72 6f er 1000 timerpro
7080: 63 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e c]. vwait don
7090: 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 e. close $s.
70a0: 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 7b set count.} {
70b0: 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a eof is sticky}..
70c0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
70d0: 74 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 t..test socket-1
70e0: 30 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 0.1 {testing soc
70f0: 6b 65 74 20 61 63 63 65 70 74 20 63 61 6c 6c 62 ket accept callb
7100: 61 63 6b 20 65 72 72 6f 72 20 68 61 6e 64 6c 69 ack error handli
7110: 6e 67 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 ng} {socket pcCr
7120: 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 ash} {. set g
7130: 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 72 oterror 0. pr
7140: 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 oc bgerror args
7150: 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 {global goterror
7160: 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 31 ; set goterror 1
7170: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
7180: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
7190: 20 61 63 63 65 70 74 20 32 38 39 38 5d 0a 20 20 accept 2898].
71a0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
71b0: 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b a p} {close $s;
71c0: 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 error}. set
71d0: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 c [tls::socket 1
71e0: 32 37 2e 30 2e 30 2e 31 20 32 38 39 38 5d 0a 20 27.0.0.1 2898].
71f0: 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 6f vwait goterro
7200: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
7210: 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 close $c.
7220: 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 31 set goterror.} 1
7230: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 ..test socket-11
7240: 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .1 {tcp connecti
7250: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 on} {socket doTe
7260: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
7270: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
7280: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
7290: 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 cket9_1_test_ser
72a0: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
72b0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
72c0: 32 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 2834]..proc acce
72d0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
72e0: 20 20 70 75 74 73 20 24 73 20 64 6f 6e 65 0a 09 puts $s done..
72f0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
7300: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
7310: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
7320: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 moteServerIP 283
7330: 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 4]. set r [ge
7340: 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $s]. close
7350: 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s. sendComm
7360: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
7370: 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 et9_1_test_serve
7380: 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 r}. set r.} d
7390: 6f 6e 65 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d one.test socket-
73a0: 31 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 11.2 {client spe
73b0: 63 69 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d cifies its port}
73c0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
73d0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
73e0: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 } {. if {[inf
73f0: 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 o exists port]}
7400: 7b 0a 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 {..incr port.
7410: 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 } else {..set p
7420: 6f 72 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b ort [expr 2048 +
7430: 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 [pid]%1024].
7440: 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }. sendComma
7450: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
7460: 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 9_2_test_server
7470: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
7480: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 35 rver accept 2835
7490: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
74a0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 70 75 s a p} {.. pu
74b0: 74 73 20 24 73 20 24 70 0a 09 20 20 20 20 63 6c ts $s $p.. cl
74c0: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
74d0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
74e0: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 socket -myport $
74f0: 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 port $remoteServ
7500: 65 72 49 50 20 32 38 33 35 5d 0a 20 20 20 20 73 erIP 2835]. s
7510: 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 et r [gets $s].
7520: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
7530: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
7540: 73 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 se $socket9_2_te
7550: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 69 st_server}. i
7560: 66 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 f {$r == $port}
7570: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 6f 6b {..set result ok
7580: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
7590: 65 74 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e et result broken
75a0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 72 . }. set r
75b0: 65 73 75 6c 74 0a 7d 20 6f 6b 0a 74 65 73 74 20 esult.} ok.test
75c0: 73 6f 63 6b 65 74 2d 31 31 2e 33 20 7b 74 72 79 socket-11.3 {try
75d0: 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 ing to connect,
75e0: 6e 6f 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b no server} {sock
75f0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
7600: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
7610: 20 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a set status ok.
7620: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
7630: 7b 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 {set s [tls::soc
7640: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ket $remoteServe
7650: 72 49 70 20 32 38 33 36 5d 7d 5d 7d 20 7b 0a 09 rIp 2836]}]} {..
7660: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 if {![catch {get
7670: 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 s $s}]} {.. s
7680: 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e et status broken
7690: 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 ..}..close $s.
76a0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 }. set stat
76b0: 75 73 0a 7d 20 6f 6b 0a 74 65 73 74 20 73 6f 63 us.} ok.test soc
76c0: 6b 65 74 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 65 ket-11.4 {remote
76d0: 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d echo, one line}
76e0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
76f0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
7700: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d } {. sendComm
7710: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
7720: 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 t10_6_test_serve
7730: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
7740: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
7750: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
7760: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
7770: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
7780: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
7790: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
77a0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
77b0: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
77c0: 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 tion crlf..}..pr
77d0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
77e0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
77f0: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
7800: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
7810: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
7820: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
7830: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
7840: 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f set f [tls::so
7850: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
7860: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 erIP 2836]. f
7870: 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 configure $f -tr
7880: 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d anslation crlf -
7890: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
78a0: 20 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f puts $f hello
78b0: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
78c0: 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $f]. close $
78d0: 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e f. sendComman
78e0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
78f0: 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 72 10_6_test_server
7900: 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 68 65 }. set r.} he
7910: 6c 6c 6f 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d llo.test socket-
7920: 31 31 2e 35 20 7b 72 65 6d 6f 74 65 20 65 63 68 11.5 {remote ech
7930: 6f 2c 20 35 30 20 6c 69 6e 65 73 7d 20 7b 73 6f o, 50 lines} {so
7940: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
7950: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
7960: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
7970: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f {..set socket10_
7980: 37 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 7_test_server [t
7990: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
79a0: 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a er accept 2836].
79b0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
79c0: 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 a p} {.. file
79d0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
79e0: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
79f0: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
7a00: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
7a10: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
7a20: 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 crlf..}..proc e
7a30: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 cho {s} {.. s
7a40: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
7a50: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
7a60: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
7a70: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 } else {...p
7a80: 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d uts $s $l.. }
7a90: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
7aa0: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
7ab0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
7ac0: 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 2836]. fconf
7ad0: 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c igure $f -transl
7ae0: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 ation crlf -buff
7af0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 ering line. f
7b00: 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 7b or {set cnt 0} {
7b10: 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 72 $cnt < 50} {incr
7b20: 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 66 cnt} {..puts $f
7b30: 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 "hello, $cnt"..
7b40: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
7b50: 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 22 68 are [gets $f] "h
7b60: 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 3d 20 ello, $cnt"] !=
7b70: 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 6b 0a 0} {.. break.
7b80: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f .}. }. clo
7b90: 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f se $f. sendCo
7ba0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
7bb0: 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 cket10_7_test_se
7bc0: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 63 6e rver}. set cn
7bd0: 74 0a 7d 20 35 30 0a 23 20 4d 61 63 69 6e 74 6f t.} 50.# Macinto
7be0: 73 68 20 73 6f 63 6b 65 74 73 20 63 61 6e 20 68 sh sockets can h
7bf0: 61 76 65 20 6d 6f 72 65 20 74 68 61 6e 20 6f 6e ave more than on
7c00: 65 20 73 65 72 76 65 72 20 70 65 72 20 70 6f 72 e server per por
7c10: 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c 61 74 66 t.if {$tcl_platf
7c20: 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 3d 3d orm(platform) ==
7c30: 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d 20 7b 0a "macintosh"} {.
7c40: 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 set conflict
7c50: 52 65 73 75 6c 74 20 7b 30 20 32 38 33 36 7d 0a Result {0 2836}.
7c60: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 73 65 74 } else {. set
7c70: 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 conflictResult
7c80: 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 {1 {couldn't ope
7c90: 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 n socket: addres
7ca0: 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 s already in use
7cb0: 7d 7d 0a 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 }}.}.test socket
7cc0: 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 74 20 63 6f -11.6 {socket co
7cd0: 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 nflict} {socket
7ce0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
7cf0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
7d00: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
7d10: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
7d20: 74 20 32 38 33 36 5d 0a 20 20 20 20 69 66 20 7b t 2836]. if {
7d30: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b [catch {set s2 [
7d40: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
7d50: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d ver accept 2836]
7d60: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 72 } msg]} {..set r
7d70: 65 73 75 6c 74 20 5b 6c 69 73 74 20 31 20 24 6d esult [list 1 $m
7d80: 73 67 5d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b sg]. } else {
7d90: 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 ..set result [li
7da0: 73 74 20 30 20 5b 6c 69 6e 64 65 78 20 5b 66 63 st 0 [lindex [fc
7db0: 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 73 6f onfigure $s2 -so
7dc0: 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c 6f ckname] 2]]..clo
7dd0: 73 65 20 24 73 32 0a 20 20 20 20 7d 0a 20 20 20 se $s2. }.
7de0: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 close $s1. s
7df0: 65 74 20 72 65 73 75 6c 74 0a 7d 20 24 63 6f 6e et result.} $con
7e00: 66 6c 69 63 74 52 65 73 75 6c 74 0a 74 65 73 74 flictResult.test
7e10: 20 73 6f 63 6b 65 74 2d 31 31 2e 37 20 7b 73 65 socket-11.7 {se
7e20: 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 61 rver with severa
7e30: 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b l clients} {sock
7e40: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
7e50: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
7e60: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
7e70: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 39 5f .set socket10_9_
7e80: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
7e90: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
7ea0: 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 accept 2836]..p
7eb0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
7ec0: 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 p} {.. fconfi
7ed0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
7ee0: 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c ng line.. fil
7ef0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
7f00: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
7f10: 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 ]..}..proc echo
7f20: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
7f30: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
7f40: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
7f50: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
7f60: 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 } else {...puts
7f70: 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a $s $l.. }..}.
7f80: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
7f90: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 [tls::socket $r
7fa0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 emoteServerIP 28
7fb0: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
7fc0: 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e re $s1 -bufferin
7fd0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
7fe0: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 2 [tls::socket $
7ff0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
8000: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
8010: 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 ure $s2 -bufferi
8020: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
8030: 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s3 [tls::socket
8040: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
8050: 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2836]. fconfi
8060: 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 gure $s3 -buffer
8070: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 ing line. for
8080: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
8090: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
80a0: 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f ..puts $s1 hello
80b0: 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 ,s1..gets $s1..p
80c0: 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 uts $s2 hello,s2
80d0: 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 ..gets $s2..puts
80e0: 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 $s3 hello,s3..g
80f0: 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ets $s3. }.
8100: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
8110: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
8120: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
8130: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
8140: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
8150: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
8160: 69 0a 7d 20 31 30 30 20 20 20 20 0a 74 65 73 74 i.} 100 .test
8170: 20 73 6f 63 6b 65 74 2d 31 31 2e 38 20 7b 63 6c socket-11.8 {cl
8180: 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 ient with severa
8190: 6c 20 73 65 72 76 65 72 73 7d 20 7b 73 6f 63 6b l servers} {sock
81a0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
81b0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
81c0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
81d0: 09 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f .set s1 [tls::so
81e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 63 cket -server "ac
81f0: 63 65 70 74 20 34 30 30 33 22 20 34 30 30 33 5d cept 4003" 4003]
8200: 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 ..set s2 [tls::s
8210: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 ocket -server "a
8220: 63 63 65 70 74 20 34 30 30 34 22 20 34 30 30 34 ccept 4004" 4004
8230: 5d 0a 09 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a ]..set s3 [tls::
8240: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 socket -server "
8250: 61 63 63 65 70 74 20 34 30 30 35 22 20 34 30 30 accept 4005" 400
8260: 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 5]..proc accept
8270: 7b 6d 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 {mp s a p} {..
8280: 20 20 70 75 74 73 20 24 73 20 24 6d 70 0a 09 20 puts $s $mp..
8290: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
82a0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
82b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
82c0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
82d0: 33 5d 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 3]. set s2 [t
82e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
82f0: 74 65 53 65 72 76 65 72 49 50 20 34 30 30 34 5d teServerIP 4004]
8300: 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 . set s3 [tls
8310: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
8320: 53 65 72 76 65 72 49 50 20 34 30 30 35 5d 0a 20 ServerIP 4005].
8330: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
8340: 6c 61 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 lappend l [gets
8350: 24 73 31 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 $s1] [gets $s1]
8360: 5b 65 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 20 [eof $s1] [gets
8370: 24 73 32 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 $s2] [gets $s2]
8380: 5b 65 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 [eof $s2] \..[ge
8390: 74 73 20 24 73 33 5d 20 5b 67 65 74 73 20 24 73 ts $s3] [gets $s
83a0: 33 5d 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 3] [eof $s3].
83b0: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 close $s1. c
83c0: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
83d0: 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 se $s3. sendC
83e0: 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 ommand {..close
83f0: 24 73 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 $s1..close $s2..
8400: 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 7d 0a close $s3. }.
8410: 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 set l.} {400
8420: 33 20 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 3 {} 1 4004 {} 1
8430: 20 34 30 30 35 20 7b 7d 20 31 7d 0a 74 65 73 74 4005 {} 1}.test
8440: 20 73 6f 63 6b 65 74 2d 31 31 2e 39 20 7b 61 63 socket-11.9 {ac
8450: 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 cept callback er
8460: 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ror} {socket doT
8470: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
8480: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
8490: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
84a0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
84b0: 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 36]. proc acc
84c0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 ept {s a p} {exp
84d0: 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 70 72 r 10 / 0}. pr
84e0: 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 oc bgerror args
84f0: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 {..global x..set
8500: 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 x $args. }.
8510: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 if {[catch {s
8520: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 endCommand {..
8530: 20 20 73 65 74 20 70 65 65 72 6e 61 6d 65 20 5b set peername [
8540: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 61 6c 6c fconfigure $call
8550: 65 72 53 6f 63 6b 65 74 20 2d 70 65 65 72 6e 61 erSocket -peerna
8560: 6d 65 5d 0a 09 20 20 20 20 73 65 74 20 73 20 5b me].. set s [
8570: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 6c 69 6e tls::socket [lin
8580: 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 5d dex $peername 0]
8590: 20 32 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f 73 2836].. clos
85a0: 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d 73 e $s. . }} ms
85b0: 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 0a g]} {..close $s.
85c0: 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 20 .error $msg.
85d0: 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 }. set timer
85e0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
85f0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
8600: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
8610: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
8620: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
8630: 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 . rename bger
8640: 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 ror {}. set x
8650: 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a .} {{divide by z
8660: 65 72 6f 7d 7d 0a 74 65 73 74 20 73 6f 63 6b 65 ero}}.test socke
8670: 74 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 6e 67 t-11.10 {testing
8680: 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 socket specific
8690: 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 options} {socke
86a0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
86b0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
86c0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
86d0: 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 32 5f set socket10_12_
86e0: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
86f0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
8700: 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 accept 2836]..p
8710: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
8720: 70 7d 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 p} {close $s}.
8730: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
8740: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
8750: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d teServerIP 2836]
8760: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
8770: 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e figure $s -peern
8780: 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b ame]. set n [
8790: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
87a0: 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 ockname]. set
87b0: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
87c0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 d l [lindex $p 2
87d0: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b ] [llength $p] [
87e0: 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 llength $p].
87f0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e close $s. sen
8800: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
8810: 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 $socket10_12_tes
8820: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
8830: 74 20 6c 0a 7d 20 7b 32 38 33 36 20 33 20 33 7d t l.} {2836 3 3}
8840: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e .test socket-11.
8850: 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 11 {testing spur
8860: 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f ious events} {so
8870: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
8880: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
8890: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
88a0: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f {..set socket10_
88b0: 31 33 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 13_test_server [
88c0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
88d0: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d ver accept 2836]
88e0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
88f0: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f a p} {.. fco
8900: 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e nfigure $s -tran
8910: 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f 20 6c 66 slation "auto lf
8920: 22 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 ".. after 100
8930: 20 77 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 7d writesome $s..}
8940: 0a 09 70 72 6f 63 20 77 72 69 74 65 73 6f 6d 65 ..proc writesome
8950: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 {s} {.. for
8960: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
8970: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
8980: 09 09 70 75 74 73 20 24 73 20 22 6c 69 6e 65 20 ..puts $s "line
8990: 24 69 20 66 72 6f 6d 20 72 65 6d 6f 74 65 20 73 $i from remote s
89a0: 65 72 76 65 72 22 0a 09 20 20 20 20 7d 0a 09 20 erver".. }..
89b0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
89c0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e }. set len
89d0: 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 0. set spuri
89e0: 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f ous 0. set do
89f0: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 ne 0. proc re
8a00: 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 adlittle {s} {..
8a10: 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 global spurious
8a20: 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 done len..set l
8a30: 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 [read $s 1]..if
8a40: 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 {[string length
8a50: 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 $l] == 0} {..
8a60: 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 if {![eof $s]}
8a70: 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 {...incr spuriou
8a80: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
8a90: 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 ..close $s...set
8aa0: 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 done 1.. }..
8ab0: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e } else {.. in
8ac0: 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c cr len [string l
8ad0: 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 ength $l]..}.
8ae0: 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c }. set c [tl
8af0: 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 s::socket $remot
8b00: 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a eServerIP 2836].
8b10: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
8b20: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 6c readable "readl
8b30: 69 74 74 6c 65 20 24 63 22 0a 20 20 20 20 73 65 ittle $c". se
8b40: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
8b50: 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 0000 "set done t
8b60: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
8b70: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 wait done. af
8b80: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
8b90: 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e r. sendComman
8ba0: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
8bb0: 31 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 65 10_13_test_serve
8bc0: 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 r}. list $spu
8bd0: 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 rious $len.} {0
8be0: 32 36 39 30 7d 0a 74 65 73 74 20 73 6f 63 6b 65 2690}.test socke
8bf0: 74 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 t-11.12 {testing
8c00: 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d EOF stickyness}
8c10: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
8c20: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
8c30: 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 75 6e } {. set coun
8c40: 74 65 72 20 30 0a 20 20 20 20 73 65 74 20 64 6f ter 0. set do
8c50: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 63 6f ne 0. proc co
8c60: 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 6c unt_up {s} {..gl
8c70: 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f 6e obal counter don
8c80: 65 20 61 66 74 65 72 5f 69 64 0a 09 73 65 74 20 e after_id..set
8c90: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 l [gets $s]..if
8ca0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
8cb0: 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a 09 incr counter..
8cc0: 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 72 if {$counter
8cd0: 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 6f > 9} {...set do
8ce0: 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b ne {EOF is stick
8cf0: 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 y}...after cance
8d00: 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 09 63 6c l $after_id...cl
8d10: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d ose $s.. }..}
8d20: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
8d30: 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 timed_out {} {..
8d40: 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 73 global c done..s
8d50: 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f et done {timed_o
8d60: 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 73 ut, EOF is not s
8d70: 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 ticky}..close $c
8d80: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
8d90: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
8da0: 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 cket10_14_test_s
8db0: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
8dc0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
8dd0: 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 2836]..proc ac
8de0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
8df0: 20 20 20 20 61 66 74 65 72 20 31 30 30 20 63 6c after 100 cl
8e00: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
8e10: 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a set c [tls::
8e20: 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 socket $remoteSe
8e30: 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 rverIP 2836].
8e40: 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 fileevent $c re
8e50: 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 adable "count_up
8e60: 20 24 63 22 0a 20 20 20 20 73 65 74 20 61 66 74 $c". set aft
8e70: 65 72 5f 69 64 20 5b 61 66 74 65 72 20 31 30 30 er_id [after 100
8e80: 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 0 timed_out].
8e90: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
8ea0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
8eb0: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f se $socket10_14_
8ec0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
8ed0: 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 set done.} {EOF
8ee0: 20 69 73 20 73 74 69 63 6b 79 7d 0a 74 65 73 74 is sticky}.test
8ef0: 20 73 6f 63 6b 65 74 2d 31 31 2e 31 33 20 7b 74 socket-11.13 {t
8f00: 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 esting async wri
8f10: 74 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 2c te, async flush,
8f20: 20 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a async close} \.
8f30: 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 .{socket doTests
8f40: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
8f50: 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 61 } {. proc rea
8f60: 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 dit {s} {..globa
8f70: 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 l count done..se
8f80: 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 t l [read $s]..i
8f90: 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e ncr count [strin
8fa0: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 g length $l]..if
8fb0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
8fc0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 close $s..
8fd0: 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 set done 1..}.
8fe0: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d }. sendCom
8ff0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 73 mand {..set firs
9000: 74 62 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b tblock ""..for {
9010: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 set i 0} {$i < 5
9020: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 73 } {incr i} {...s
9030: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 61 et firstblock "a
9040: 24 66 69 72 73 74 62 6c 6f 63 6b 24 66 69 72 73 $firstblock$firs
9050: 74 62 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 tblock"..}..set
9060: 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a 09 secondblock ""..
9070: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
9080: 69 20 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d i < 16} {incr i}
9090: 20 7b 0a 09 20 20 20 20 73 65 74 20 73 65 63 6f {.. set seco
90a0: 6e 64 62 6c 6f 63 6b 20 22 62 24 73 65 63 6f 6e ndblock "b$secon
90b0: 64 62 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 6c 6f dblock$secondblo
90c0: 63 6b 22 0a 09 7d 0a 09 73 65 74 20 6c 20 5b 74 ck"..}..set l [t
90d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
90e0: 65 72 20 61 63 63 65 70 74 20 32 38 34 35 5d 0a er accept 2845].
90f0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
9100: 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e a p} {.. fcon
9110: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
9120: 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 ing 0 -translati
9130: 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a on lf -buffersiz
9140: 65 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 e 16384 \...-buf
9150: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
9160: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
9170: 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 adable "readable
9180: 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 65 $s"..}..proc re
9190: 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 adable {s} {..
91a0: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
91b0: 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 ].. fileevent
91c0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a $s readable {}.
91d0: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
91e0: 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 respond $s..}..p
91f0: 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 roc respond {s}
9200: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 69 {.. global fi
9210: 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 rstblock.. pu
9220: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
9230: 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 $firstblock..
9240: 20 20 61 66 74 65 72 20 31 30 30 30 20 77 72 69 after 1000 wri
9250: 74 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 72 tedata $s..}..pr
9260: 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d oc writedata {s}
9270: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 {.. global s
9280: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 econdblock..
9290: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
92a0: 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a $s $secondblock.
92b0: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d . close $s..}
92c0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
92d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 [tls::socket $r
92e0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 emoteServerIP 28
92f0: 34 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 45]. fconfigu
9300: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
9310: 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 0 -trans lf -buf
9320: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
9330: 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 set count 0.
9340: 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 puts $s hello.
9350: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
9360: 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 eadable "readit
9370: 24 73 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $s". set time
9380: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
9390: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
93a0: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
93b0: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
93c0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
93d0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
93e0: 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 se $l}. set c
93f0: 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 ount.} 65566..te
9400: 73 74 20 73 6f 63 6b 65 74 2d 31 32 2e 31 20 7b st socket-12.1 {
9410: 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 testing inherita
9420: 6e 63 65 20 6f 66 20 73 65 72 76 65 72 20 73 6f nce of server so
9430: 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 ckets} \..{socke
9440: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
9450: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
9460: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
9470: 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 pt1. removeFi
9480: 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 le script2..
9490: 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 # Script1 is jus
94a0: 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 t a 10 second de
94b0: 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 lay. If the ser
94c0: 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 ver socket. #
94d0: 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 is inherited, i
94e0: 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f t will be held o
94f0: 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e pen for 10 secon
9500: 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ds.. set f [o
9510: 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 pen script1 w].
9520: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 puts $f {..af
9530: 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 ter 10000 exit..
9540: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
9550: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
9560: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 .. # Script2
9570: 63 72 65 61 74 65 73 20 74 68 65 20 73 65 72 76 creates the serv
9580: 65 72 20 73 6f 63 6b 65 74 2c 20 6c 61 75 6e 63 er socket, launc
9590: 68 65 73 20 73 63 72 69 70 74 31 2c 0a 20 20 20 hes script1,.
95a0: 20 23 20 77 61 69 74 73 20 61 20 73 65 63 6f 6e # waits a secon
95b0: 64 2c 20 61 6e 64 20 65 78 69 74 73 2e 20 20 54 d, and exits. T
95c0: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
95d0: 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 20 23 20 will now. #
95e0: 62 65 20 63 6c 6f 73 65 64 20 75 6e 6c 65 73 73 be closed unless
95f0: 20 73 63 72 69 70 74 31 20 69 6e 68 65 72 69 74 script1 inherit
9600: 65 64 20 69 74 2e 0a 0a 20 20 20 20 73 65 74 20 ed it... set
9610: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 f [open script2
9620: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
9630: 6c 69 73 74 20 73 65 74 20 74 63 6c 74 65 73 74 list set tcltest
9640: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
9650: 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 test]. puts $
9660: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
9670: 75 69 72 65 20 74 63 6c 74 65 73 74 0a 09 73 65 uire tcltest..se
9680: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
9690: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
96a0: 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 2828]..proc acce
96b0: 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 pt { file addr p
96c0: 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f ort } {.. clo
96d0: 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65 se $file..}..exe
96e0: 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 c $::tcltest::tc
96f0: 6c 74 65 73 74 20 73 63 72 69 70 74 31 20 26 0a ltest script1 &.
9700: 09 63 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 72 .close $f..after
9710: 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 1000 exit..vwai
9720: 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a t forever. }.
9730: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 09 0a 20 close $f...
9740: 20 20 20 23 20 4c 61 75 6e 63 68 20 73 63 72 69 # Launch scri
9750: 70 74 32 20 61 6e 64 20 77 61 69 74 20 35 20 73 pt2 and wait 5 s
9760: 65 63 6f 6e 64 73 0a 0a 20 20 20 20 65 78 65 63 econds.. exec
9770: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
9780: 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 20 test script2 &.
9790: 20 20 20 61 66 74 65 72 20 35 30 30 30 20 7b 20 after 5000 {
97a0: 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 set ok_to_procee
97b0: 64 20 31 20 7d 0a 20 20 20 20 76 77 61 69 74 20 d 1 }. vwait
97c0: 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 ok_to_proceed..
97d0: 20 20 20 23 20 49 66 20 77 65 20 63 61 6e 20 73 # If we can s
97e0: 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 till connect to
97f0: 74 68 65 20 73 65 72 76 65 72 2c 20 74 68 65 20 the server, the
9800: 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 socket got inher
9810: 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b ited... if {[
9820: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
9830: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 et 127.0.0.1 282
9840: 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 8} msg]} {..set
9850: 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 x {server socket
9860: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
9870: 65 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b ed}. } else {
9880: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 73 65 ..close $msg..se
9890: 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b t x {server sock
98a0: 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 et was inherited
98b0: 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 72 65 6d }. }.. rem
98c0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
98d0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
98e0: 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 cript2. set x
98f0: 0a 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 .} {server socke
9900: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
9910: 74 65 64 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 ted}.test socket
9920: 2d 31 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 69 -12.2 {testing i
9930: 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 63 6c nheritance of cl
9940: 69 65 6e 74 20 73 6f 63 6b 65 74 73 7d 20 5c 0a ient sockets} \.
9950: 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 .{socket doTests
9960: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
9970: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
9980: 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 le script1. r
9990: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
99a0: 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 2.. # Script1
99b0: 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 is just a 10 se
99c0: 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 cond delay. If
99d0: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
99e0: 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 t. # is inher
99f0: 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 ited, it will be
9a00: 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 held open for 1
9a10: 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 0 seconds.. s
9a20: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
9a30: 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t1 w]. puts $
9a40: 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 f {..after 10000
9a50: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
9a60: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
9a70: 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 lose $f.. # S
9a80: 63 72 69 70 74 32 20 6f 70 65 6e 73 20 74 68 65 cript2 opens the
9a90: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 61 client socket a
9aa0: 6e 64 20 77 72 69 74 65 73 20 74 6f 20 69 74 2e nd writes to it.
9ab0: 20 20 49 74 20 74 68 65 6e 0a 20 20 20 20 23 20 It then. #
9ac0: 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 launches script1
9ad0: 20 61 6e 64 20 65 78 69 74 73 2e 20 20 49 66 20 and exits. If
9ae0: 74 68 65 20 63 68 69 6c 64 20 70 72 6f 63 65 73 the child proces
9af0: 73 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 0a s inherited the.
9b00: 20 20 20 20 23 20 63 6c 69 65 6e 74 20 73 6f 63 # client soc
9b10: 6b 65 74 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 ket, the socket
9b20: 77 69 6c 6c 20 73 74 69 6c 6c 20 62 65 20 6f 70 will still be op
9b30: 65 6e 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b en... set f [
9b40: 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a open script2 w].
9b50: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
9b60: 74 20 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a t set tcltest $:
9b70: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
9b80: 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b t]. puts $f {
9b90: 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f ..set f [tls::so
9ba0: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
9bb0: 38 32 39 5d 0a 09 65 78 65 63 20 24 3a 3a 74 63 829]..exec $::tc
9bc0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
9bd0: 63 72 69 70 74 31 20 26 0a 09 70 75 74 73 20 24 cript1 &..puts $
9be0: 66 20 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 68 f testing..flush
9bf0: 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 $f..after 1000
9c00: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
9c10: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
9c20: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 43 72 ose $f.. # Cr
9c30: 65 61 74 65 20 74 68 65 20 73 65 72 76 65 72 20 eate the server
9c40: 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 20 socket.. set
9c50: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
9c60: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
9c70: 70 74 20 32 38 32 39 5d 0a 20 20 20 20 70 72 6f pt 2829]. pro
9c80: 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 c accept { file
9c90: 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 0a 09 host port } {...
9ca0: 23 20 57 68 65 6e 20 74 68 65 20 63 6c 69 65 6e # When the clien
9cb0: 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 61 t connects, esta
9cc0: 62 6c 69 73 68 20 74 68 65 20 72 65 61 64 20 68 blish the read h
9cd0: 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 73 andler..global s
9ce0: 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 65 erver..close $se
9cf0: 72 76 65 72 0a 09 66 69 6c 65 65 76 65 6e 74 20 rver..fileevent
9d00: 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5b $file readable [
9d10: 6c 69 73 74 20 67 65 74 64 61 74 61 20 24 66 69 list getdata $fi
9d20: 6c 65 5d 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 le]..fconfigure
9d30: 24 66 69 6c 65 20 2d 62 75 66 66 65 72 69 6e 67 $file -buffering
9d40: 20 6c 69 6e 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 line -blocking
9d50: 30 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0..return. }.
9d60: 20 20 20 20 70 72 6f 63 20 67 65 74 64 61 74 61 proc getdata
9d70: 20 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 20 { file } {...#
9d80: 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 Read handler on
9d90: 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 the accepted soc
9da0: 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 ket...global x..
9db0: 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 09 73 global failed..s
9dc0: 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 68 et status [catch
9dd0: 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 61 {read $file} da
9de0: 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 75 73 ta]..if {$status
9df0: 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 != 0} {.. se
9e00: 74 20 78 20 7b 72 65 61 64 20 66 61 69 6c 65 64 t x {read failed
9e10: 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 , error was $dat
9e20: 61 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 a}.. catch {
9e30: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d close $file }..}
9e40: 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 elseif {[string
9e50: 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 compare {} $dat
9e60: 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 a]} {..} elseif
9e70: 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 {[fblocked $file
9e80: 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b ]} {..} elseif {
9e90: 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 [eof $file]} {..
9ea0: 20 20 20 20 69 66 20 7b 24 66 61 69 6c 65 64 7d if {$failed}
9eb0: 20 7b 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 {...set x {clie
9ec0: 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e nt socket was in
9ed0: 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 20 herited}.. }
9ee0: 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 20 7b else {...set x {
9ef0: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 client socket wa
9f00: 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d s not inherited}
9f10: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 61 74 .. }.. cat
9f20: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
9f30: 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 }..} else {..
9f40: 20 20 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 set x {impossi
9f50: 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 20 20 63 ble case}.. c
9f60: 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 atch { close $fi
9f70: 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e 0a le }..}..return.
9f80: 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 49 66 20 }.. # If
9f90: 74 68 65 20 73 6f 63 6b 65 74 20 64 6f 65 73 6e the socket doesn
9fa0: 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 2d 66 69 't hit end-of-fi
9fb0: 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e 64 73 2c le in 5 seconds,
9fc0: 20 74 68 65 0a 20 20 20 20 23 20 73 63 72 69 70 the. # scrip
9fd0: 74 31 20 70 72 6f 63 65 73 73 20 6d 75 73 74 20 t1 process must
9fe0: 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 have inherited t
9ff0: 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 20 he client...
a000: 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 set failed 0.
a010: 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 73 after 5000 [lis
a020: 74 20 73 65 74 20 66 61 69 6c 65 64 20 31 5d 0a t set failed 1].
a030: 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 . # Launch th
a040: 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 e script2 proces
a050: 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 s.. exec $::t
a060: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
a070: 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 76 script2 &.. v
a080: 77 61 69 74 20 78 0a 20 20 20 20 69 66 20 7b 21 wait x. if {!
a090: 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 $failed} {..vwai
a0a0: 74 20 66 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 t failed. }.
a0b0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
a0c0: 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 ript1. remove
a0d0: 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 File script2.
a0e0: 20 73 65 74 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 set x.} {client
a0f0: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
a100: 69 6e 68 65 72 69 74 65 64 7d 0a 74 65 73 74 20 inherited}.test
a110: 73 6f 63 6b 65 74 2d 31 32 2e 33 20 7b 74 65 73 socket-12.3 {tes
a120: 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 ting inheritance
a130: 20 6f 66 20 61 63 63 65 70 74 65 64 20 73 6f 63 of accepted soc
a140: 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 kets} \..{socket
a150: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
a160: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
a170: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
a180: 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c t1. removeFil
a190: 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 73 e script2.. s
a1a0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
a1b0: 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t1 w]. puts $
a1c0: 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 f {..after 10000
a1d0: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
a1e0: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
a1f0: 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 65 74 lose $f.. set
a200: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 f [open script2
a210: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
a220: 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 74 65 73 [list set tcltes
a230: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
a240: 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 ltest]. puts
a250: 24 66 20 7b 0a 09 73 65 74 20 73 65 72 76 65 72 $f {..set server
a260: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
a270: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 39 33 erver accept 293
a280: 30 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 0]..proc accept
a290: 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 { file host port
a2a0: 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c } {.. global
a2b0: 20 74 63 6c 74 65 73 74 0a 09 20 20 20 20 70 75 tcltest.. pu
a2c0: 74 73 20 24 66 69 6c 65 20 7b 74 65 73 74 20 64 ts $file {test d
a2d0: 61 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 ata on socket}..
a2e0: 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 exec $::tclt
a2f0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
a300: 69 70 74 31 20 26 0a 09 20 20 20 20 61 66 74 65 ipt1 &.. afte
a310: 72 20 31 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 r 1000 exit..}..
a320: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
a330: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
a340: 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 .. # Launch t
a350: 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 he script2 proce
a360: 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 ss and connect t
a370: 6f 20 69 74 2e 20 20 53 65 65 20 68 6f 77 20 6c o it. See how l
a380: 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 20 73 6f ong. # the so
a390: 63 6b 65 74 20 73 74 61 79 73 20 6f 70 65 6e 0a cket stays open.
a3a0: 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c . exec $::tcl
a3b0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
a3c0: 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61 66 74 ript2 &.. aft
a3d0: 65 72 20 31 30 30 30 20 73 65 74 20 6f 6b 5f 74 er 1000 set ok_t
a3e0: 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 20 20 o_proceed 1.
a3f0: 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 vwait ok_to_proc
a400: 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66 20 5b eed.. set f [
a410: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
a420: 30 2e 30 2e 31 20 32 39 33 30 5d 0a 20 20 20 20 0.0.1 2930].
a430: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 62 fconfigure $f -b
a440: 75 66 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d 62 uffering full -b
a450: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 66 69 locking 0. fi
a460: 6c 65 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 leevent $f reada
a470: 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 ble [list getdat
a480: 61 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 a $f].. # If
a490: 74 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 74 the socket is st
a4a0: 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 35 ill open after 5
a4b0: 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 seconds, the sc
a4c0: 72 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 20 ript1 process.
a4d0: 20 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 6e # must have in
a4e0: 68 65 72 69 74 65 64 20 74 68 65 20 61 63 63 65 herited the acce
a4f0: 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 pted socket...
a500: 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 set failed 0.
a510: 20 20 20 61 66 74 65 72 20 35 30 30 30 20 73 65 after 5000 se
a520: 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 t failed 1..
a530: 70 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 proc getdata { f
a540: 69 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 ile } {...# Read
a550: 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 handler on the
a560: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2e 0a 09 client socket...
a570: 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c global x..global
a580: 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 failed..set sta
a590: 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 tus [catch {read
a5a0: 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 $file} data]..i
a5b0: 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d f {$status != 0}
a5c0: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 {.. set x {r
a5d0: 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f ead failed, erro
a5e0: 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 r was $data}..
a5f0: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
a600: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 $file }..} elsei
a610: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
a620: 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a re {} $data]} {.
a630: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f .} elseif {[fblo
a640: 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 cked $file]} {..
a650: 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 } elseif {[eof $
a660: 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 file]} {.. if
a670: 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 {$failed} {...s
a680: 65 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 73 et x {accepted s
a690: 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 ocket was inheri
a6a0: 74 65 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 ted}.. } else
a6b0: 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 63 65 {...set x {acce
a6c0: 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 pted socket was
a6d0: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 not inherited}..
a6e0: 20 20 20 20 7d 0a 09 20 20 20 20 63 61 74 63 68 }.. catch
a6f0: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
a700: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
a710: 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c set x {impossibl
a720: 65 20 63 61 73 65 7d 0a 09 20 20 20 20 63 61 74 e case}.. cat
a730: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
a740: 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e 0a 20 20 }..}..return.
a750: 20 20 7d 0a 20 20 20 20 0a 20 20 20 20 76 77 61 }. . vwa
a760: 69 74 20 78 0a 0a 20 20 20 20 72 65 6d 6f 76 65 it x.. remove
a770: 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 File script1.
a780: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
a790: 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 pt2. set x.}
a7a0: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
a7b0: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
a7c0: 65 64 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 ed}..test socket
a7d0: 2d 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 75 -13.1 {Testing u
a7e0: 73 65 20 6f 66 20 73 68 61 72 65 64 20 73 6f 63 se of shared soc
a7f0: 6b 65 74 20 62 65 74 77 65 65 6e 20 74 77 6f 20 ket between two
a800: 74 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 threads} \..{soc
a810: 6b 65 74 20 74 65 73 74 74 68 72 65 61 64 7d 20 ket testthread}
a820: 7b 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {.. removeFil
a830: 65 20 73 63 72 69 70 74 0a 20 20 20 20 74 68 72 e script. thr
a840: 65 61 64 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b eadReap.. mak
a850: 65 46 69 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 eFile {. .pac
a860: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
a870: 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f ..set f [tls::so
a880: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
a890: 65 70 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 ept 2828]..proc
a8a0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
a8b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
a8c0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
a8d0: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
a8e0: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 ]. fc
a8f0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
a900: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
a910: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
a920: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f {s} {.. glo
a930: 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 bal i.
a940: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
a950: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
a960: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
a970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a980: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
a990: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
a9a0: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
a9b0: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
a9c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 } e
a9d0: 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 lse { ..
a9e0: 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 incr i.
a9f0: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
aa00: 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 $l.
aa10: 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 }..}..set i 0..
aa20: 76 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 vwait x..close $
aa30: 66 0a 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 f...# thread cle
aa40: 61 6e 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 ans itself up...
aa50: 74 65 73 74 74 68 72 65 61 64 20 65 78 69 74 0a testthread exit.
aa60: 20 20 20 20 7d 20 73 63 72 69 70 74 0a 20 20 20 } script.
aa70: 20 0a 20 20 20 20 23 20 63 72 65 61 74 65 20 61 . # create a
aa80: 20 74 68 72 65 61 64 0a 20 20 20 20 73 65 74 20 thread. set
aa90: 73 65 72 76 65 72 74 68 72 65 61 64 20 5b 74 65 serverthread [te
aaa0: 73 74 74 68 72 65 61 64 20 63 72 65 61 74 65 20 stthread create
aab0: 7b 20 73 6f 75 72 63 65 20 73 63 72 69 70 74 20 { source script
aac0: 7d 20 5d 0a 20 20 20 20 75 70 64 61 74 65 0a 20 } ]. update.
aad0: 20 20 20 0a 20 20 20 20 61 66 74 65 72 20 31 30 . after 10
aae0: 30 30 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 00. set s [tl
aaf0: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
ab00: 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 0.1 2828]. fc
ab10: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
ab20: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 fering line..
ab30: 20 63 61 74 63 68 20 7b 0a 09 70 75 74 73 20 24 catch {..puts $
ab40: 73 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 s "hello"..gets
ab50: 24 73 20 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a $s result. }.
ab60: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
ab70: 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 74 update.. aft
ab80: 65 72 20 32 30 30 30 0a 20 20 20 20 6c 61 70 70 er 2000. lapp
ab90: 65 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 72 65 end result [thre
aba0: 61 64 52 65 61 70 5d 0a 20 20 20 20 0a 20 20 20 adReap]. .
abb0: 20 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b set result..} {
abc0: 68 65 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c 65 61 hello 1}..# clea
abd0: 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 20 nup.if {[string
abe0: 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f 6d match sock* $com
abf0: 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 mandSocket] == 1
ac00: 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 6d } {. puts $com
ac10: 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 0a mandSocket exit.
ac20: 20 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 6e flush $comman
ac30: 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 20 dSocket.}.catch
ac40: 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 {close $commandS
ac50: 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 6c ocket}.catch {cl
ac60: 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 43 ose $remoteProcC
ac70: 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a han}.::tcltest::
ac80: 63 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 6c 75 cleanupTests.flu
ac90: 73 68 20 73 74 64 6f 75 74 0a 72 65 74 75 72 6e sh stdout.return
aca0: 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a ............