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 31 20 32 30 30 30 2f test,v 1.1 2000/
0210: 30 36 2f 30 32 20 31 38 3a 34 37 3a 33 38 20 61 06/02 18:47:38 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 23 20 53 6f 6d 65 20 74 65 e tls..# Some te
0bb0: 73 74 73 20 72 65 71 75 69 72 65 20 74 68 65 20 sts require the
0bc0: 74 65 73 74 74 68 72 65 61 64 20 63 6f 6d 6d 61 testthread comma
0bd0: 6e 64 0a 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 nd..set ::tcltes
0be0: 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e t::testConstrain
0bf0: 74 73 28 74 65 73 74 74 68 72 65 61 64 29 20 5c ts(testthread) \
0c00: 0a 09 5b 65 78 70 72 20 7b 5b 69 6e 66 6f 20 63 ..[expr {[info c
0c10: 6f 6d 6d 61 6e 64 73 20 74 65 73 74 74 68 72 65 ommands testthre
0c20: 61 64 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a 23 ad] != {}}]..#.#
0c30: 20 49 66 20 72 65 6d 6f 74 65 53 65 72 76 65 72 If remoteServer
0c40: 49 50 20 6f 72 20 72 65 6d 6f 74 65 53 65 72 76 IP or remoteServ
0c50: 65 72 50 6f 72 74 20 61 72 65 20 6e 6f 74 20 73 erPort are not s
0c60: 65 74 2c 20 63 68 65 63 6b 20 69 6e 20 74 68 65 et, check in the
0c70: 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 .# environment v
0c80: 61 72 69 61 62 6c 65 73 20 66 6f 72 20 65 78 74 ariables for ext
0c90: 65 72 6e 61 6c 6c 79 20 73 65 74 20 76 61 6c 75 ernally set valu
0ca0: 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e 66 es..#..if {![inf
0cb0: 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 o exists remoteS
0cc0: 65 72 76 65 72 49 50 5d 7d 20 7b 0a 20 20 20 20 erverIP]} {.
0cd0: 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 if {[info exists
0ce0: 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 env(remoteServe
0cf0: 72 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 rIP)]} {..set re
0d00: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 65 6e moteServerIP $en
0d10: 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 v(remoteServerIP
0d20: 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b ). }.}.if {![
0d30: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
0d40: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b teServerPort]} {
0d50: 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 . if {[info e
0d60: 78 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 xists env(remote
0d70: 53 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 ServerIP)]} {..s
0d80: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 et remoteServerP
0d90: 6f 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 ort $env(remoteS
0da0: 65 72 76 65 72 50 6f 72 74 29 0a 20 20 20 20 7d erverPort). }
0db0: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
0dc0: 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 if {[info exists
0dd0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d remoteServerIP]
0de0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d } {.. set rem
0df0: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 32 30 oteServerPort 20
0e00: 34 38 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 48. }.
0e10: 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 6b 20 }.}..#.# Check
0e20: 69 66 20 77 65 27 72 65 20 73 75 70 70 6f 73 65 if we're suppose
0e30: 64 20 74 6f 20 64 6f 20 74 65 73 74 73 20 61 67 d to do tests ag
0e40: 61 69 6e 73 74 20 74 68 65 20 72 65 6d 6f 74 65 ainst the remote
0e50: 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 20 64 server.#..set d
0e60: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
0e70: 53 65 72 76 65 72 20 31 0a 69 66 20 7b 21 5b 69 Server 1.if {![i
0e80: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 nfo exists remot
0e90: 65 53 65 72 76 65 72 49 50 5d 20 26 26 20 28 24 eServerIP] && ($
0ea0: 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 tcl_platform(pla
0eb0: 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 69 6e tform) != "macin
0ec0: 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 73 65 tosh")} {. se
0ed0: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 t remoteServerIP
0ee0: 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 66 20 127.0.0.1.}.if
0ef0: 7b 28 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 {($doTestsWithRe
0f00: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 29 moteServer == 1)
0f10: 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 69 73 && (![info exis
0f20: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 ts remoteServerP
0f30: 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 65 74 ort])} {. set
0f40: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 remoteServerPor
0f50: 74 20 32 30 34 38 0a 7d 0a 0a 23 20 41 74 74 65 t 2048.}..# Atte
0f60: 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 mpt to connect t
0f70: 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 o a remote serve
0f80: 72 20 69 66 20 6f 6e 65 20 69 73 20 61 6c 72 65 r if one is alre
0f90: 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 66 20 ady running. If
0fa0: 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 6e 6e it.# is not runn
0fb0: 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d 65 20 ing or for some
0fc0: 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 74 68 65 other reason the
0fd0: 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 2c 20 connect fails,
0fe0: 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 74 61 attempt to.# sta
0ff0: 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 rt the remote se
1000: 72 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f 63 61 rver on the loca
1010: 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 6e 67 l host listening
1020: 20 6f 6e 20 70 6f 72 74 20 32 30 34 38 2e 20 54 on port 2048. T
1030: 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 64 6f his.# is only do
1040: 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 ne on platforms
1050: 74 68 61 74 20 73 75 70 70 6f 72 74 20 65 78 65 that support exe
1060: 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 c (i.e. not on t
1070: 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 70 6c he Mac). On.# pl
1080: 61 74 66 6f 72 6d 73 20 74 68 61 74 20 64 6f 20 atforms that do
1090: 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 not support exec
10a0: 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 , the remote ser
10b0: 76 65 72 20 6d 75 73 74 20 62 65 20 73 74 61 72 ver must be star
10c0: 74 65 64 0a 23 20 62 79 20 74 68 65 20 75 73 65 ted.# by the use
10d0: 72 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 r before running
10e0: 20 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 65 74 the tests...set
10f0: 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 remoteProcChan
1100: 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f "".set commandSo
1110: 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 6f 54 cket "".if {$doT
1120: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1130: 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 74 63 rver} {. catc
1140: 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e h {close $comman
1150: 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 66 20 dSocket}. if
1160: 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d {[catch {set com
1170: 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a mandSocket [tls:
1180: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
1190: 65 72 76 65 72 49 50 20 5c 0a 09 09 09 09 09 09 erverIP \.......
11a0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 $remoteServerPor
11b0: 74 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 69 66 t]}] != 0} {..if
11c0: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 {[info commands
11d0: 20 65 78 65 63 5d 20 3d 3d 20 22 22 7d 20 7b 0a exec] == ""} {.
11e0: 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f 74 . set noRemot
11f0: 65 54 65 73 74 52 65 61 73 6f 6e 20 22 63 61 6e eTestReason "can
1200: 27 74 20 65 78 65 63 22 0a 09 20 20 20 20 73 65 't exec".. se
1210: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
1220: 6f 74 65 53 65 72 76 65 72 20 30 0a 09 7d 20 65 oteServer 0..} e
1230: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 72 lse {.. set r
1240: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 emoteServerIP 12
1250: 37 2e 30 2e 30 2e 31 0a 09 20 20 20 20 73 65 74 7.0.0.1.. set
1260: 20 72 65 6d 6f 74 65 46 69 6c 65 20 5b 66 69 6c remoteFile [fil
1270: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 65 6d e join [pwd] rem
1280: 6f 74 65 2e 74 63 6c 5d 0a 09 20 20 20 20 69 66 ote.tcl].. if
1290: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 72 65 {[catch {set re
12a0: 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 5c 0a 09 moteProcChan \..
12b0: 09 09 09 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 ...[open "|[list
12c0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
12d0: 74 65 73 74 20 24 72 65 6d 6f 74 65 46 69 6c 65 test $remoteFile
12e0: 20 5c 0a 09 09 09 09 09 2d 73 65 72 76 65 72 49 \......-serverI
12f0: 73 53 69 6c 65 6e 74 20 5c 0a 09 09 09 09 09 2d sSilent \......-
1300: 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 port $remoteServ
1310: 65 72 50 6f 72 74 20 5c 0a 09 09 09 09 09 2d 61 erPort \......-a
1320: 64 64 72 65 73 73 20 24 72 65 6d 6f 74 65 53 65 ddress $remoteSe
1330: 72 76 65 72 49 50 5d 22 20 5c 0a 09 09 09 09 09 rverIP]" \......
1340: 77 2b 5d 7d 20 5c 0a 09 09 20 20 20 6d 73 67 5d w+]} \... msg]
1350: 20 3d 3d 20 30 7d 20 7b 0a 09 09 61 66 74 65 72 == 0} {...after
1360: 20 31 30 30 30 0a 09 09 69 66 20 7b 5b 63 61 74 1000...if {[cat
1370: 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 ch {set commandS
1380: 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b ocket [tls::sock
1390: 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 et $remoteServer
13a0: 49 50 20 5c 0a 09 09 09 09 24 72 65 6d 6f 74 65 IP \.....$remote
13b0: 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 ServerPort]} msg
13c0: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 ] == 0} {...
13d0: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d fconfigure $comm
13e0: 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 andSocket -trans
13f0: 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 lation crlf -buf
1400: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 7d 20 fering line...}
1410: 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 65 74 else {... set
1420: 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 noRemoteTestRea
1430: 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 20 73 son $msg... s
1440: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
1450: 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 09 7d moteServer 0...}
1460: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
1470: 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 .set noRemoteTes
1480: 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 24 3a tReason "$msg $:
1490: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
14a0: 74 22 0a 09 09 73 65 74 20 64 6f 54 65 73 74 73 t"...set doTests
14b0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
14c0: 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 0.. }..}.
14d0: 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f 6e 66 } else {..fconf
14e0: 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f igure $commandSo
14f0: 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f cket -translatio
1500: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
1510: 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d 0a 0a g line. }.}..
1520: 23 20 53 6f 6d 65 20 74 65 73 74 73 20 61 72 65 # Some tests are
1530: 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 65 20 run only if we
1540: 61 72 65 20 64 6f 69 6e 67 20 74 65 73 74 69 6e are doing testin
1550: 67 20 61 67 61 69 6e 73 74 20 61 20 72 65 6d 6f g against a remo
1560: 74 65 20 73 65 72 76 65 72 2e 0a 73 65 74 20 3a te server..set :
1570: 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f :tcltest::testCo
1580: 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 65 73 74 nstraints(doTest
1590: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
15a0: 72 29 20 24 64 6f 54 65 73 74 73 57 69 74 68 52 r) $doTestsWithR
15b0: 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 20 7b emoteServer.if {
15c0: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
15d0: 74 65 53 65 72 76 65 72 20 3d 3d 20 30 7d 20 7b teServer == 0} {
15e0: 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 . if {[string
15f0: 20 66 69 72 73 74 20 73 20 24 3a 3a 74 63 6c 74 first s $::tclt
1600: 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 21 3d est::verbose] !=
1610: 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 74 73 -1} {. .puts
1620: 20 22 53 6b 69 70 70 69 6e 67 20 74 65 73 74 73 "Skipping tests
1630: 20 77 69 74 68 20 72 65 6d 6f 74 65 20 73 65 72 with remote ser
1640: 76 65 72 2e 20 53 65 65 20 74 65 73 74 73 2f 73 ver. See tests/s
1650: 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 22 0a ocket.test for".
1660: 09 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 74 69 .puts "informati
1670: 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 75 6e on on how to run
1680: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 22 remote server."
1690: 0a 09 70 75 74 73 20 22 52 65 61 73 6f 6e 20 66 ..puts "Reason f
16a0: 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 65 6d or not doing rem
16b0: 6f 74 65 20 74 65 73 74 73 3a 20 24 6e 6f 52 65 ote tests: $noRe
16c0: 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 22 0a moteTestReason".
16d0: 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 }.}..#.# If
16e0: 77 65 20 64 6f 20 74 68 65 20 74 65 73 74 73 2c we do the tests,
16f0: 20 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d 61 6e define a comman
1700: 64 20 74 6f 20 73 65 6e 64 20 61 20 63 6f 6d 6d d to send a comm
1710: 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 65 6d and to the.# rem
1720: 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 0a 0a 69 ote server..#..i
1730: 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 f {$doTestsWithR
1740: 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 emoteServer == 1
1750: 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 65 6e } {. proc sen
1760: 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 dCommand {c} {..
1770: 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f global commandSo
1780: 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 cket...if {[eof
1790: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d $commandSocket]}
17a0: 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 {.. error "r
17b0: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 emote server dis
17c0: 61 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a 09 69 appeared"..}...i
17d0: 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 f {[catch {puts
17e0: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 24 $commandSocket $
17f0: 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 c} msg]} {..
1800: 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 error "remote se
1810: 72 76 65 72 20 64 69 73 61 70 70 61 65 72 65 64 rver disappaered
1820: 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 20 7b : $msg"..}..if {
1830: 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f [catch {puts $co
1840: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d 2d 4d mmandSocket "--M
1850: 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d arker--Marker--M
1860: 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 arker--"} msg]}
1870: 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 {.. error "re
1880: 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 mote server disa
1890: 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 ppeared: $msg"..
18a0: 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 22 22 0a }...set resp "".
18b0: 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 .while {1} {..
18c0: 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 74 73 set line [gets
18d0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
18e0: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
18f0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 commandSocket]}
1900: 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 6d 6f 74 {...error "remot
1910: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 61 e server disappa
1920: 65 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 20 20 ered".. }..
1930: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f if {[string co
1940: 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 2d 2d 4d mpare $line "--M
1950: 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d arker--Marker--M
1960: 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 arker--"] == 0}
1970: 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 {...if {[string
1980: 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 compare [lindex
1990: 24 72 65 73 70 20 30 5d 20 65 72 72 6f 72 5d 20 $resp 0] error]
19a0: 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 65 72 == 0} {... er
19b0: 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 ror [lindex $res
19c0: 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a p 1]...} else {.
19d0: 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 .. return [li
19e0: 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 ndex $resp 1]...
19f0: 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a }.. } else {.
1a00: 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 24 6c ..append resp $l
1a10: 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a ine "\n".. }.
1a20: 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 73 74 .}. }.}..test
1a30: 20 73 6f 63 6b 65 74 2d 31 2e 31 20 7b 61 72 67 socket-1.1 {arg
1a40: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
1a50: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
1a60: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
1a70: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
1a80: 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d 73 cket -server} ms
1a90: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
1aa0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
1ab0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
1ac0: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
1ad0: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
1ae0: 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 t"}}..test socke
1af0: 74 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 t-1.2 {arg parsi
1b00: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1b10: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1b20: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1b30: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1b40: 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d server foo} msg]
1b50: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
1b60: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
1b70: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
1b80: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
1b90: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
1ba0: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
1bb0: 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.3 {arg parsing
1bc0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
1bd0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
1be0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
1bf0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
1c00: 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a addr} msg] $msg.
1c10: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
1c20: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
1c30: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
1c40: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
1c50: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 }..test socket-1
1c60: 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .4 {arg parsing
1c70: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1c80: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1c90: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1ca0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
1cb0: 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d ddr 127.0.0.1} m
1cc0: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
1cd0: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
1ce0: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
1cf0: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
1d00: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
1d10: 20 73 6f 63 6b 65 74 2d 31 2e 35 20 7b 61 72 67 socket-1.5 {arg
1d20: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
1d30: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
1d40: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
1d50: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
1d60: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 cket -myport} ms
1d70: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
1d80: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
1d90: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
1da0: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
1db0: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
1dc0: 73 6f 63 6b 65 74 2d 31 2e 36 20 7b 61 72 67 20 socket-1.6 {arg
1dd0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
1de0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
1df0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
1e00: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
1e10: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 ket -myport xxxx
1e20: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
1e30: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
1e40: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
1e50: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
1e60: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
1e70: 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 37 20 7b est socket-1.7 {
1e80: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
1e90: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
1ea0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
1eb0: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
1ec0: 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 :socket -myport
1ed0: 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 2522} msg] $msg.
1ee0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
1ef0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
1f00: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
1f10: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
1f20: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 }..test socket-1
1f30: 2e 38 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .8 {arg parsing
1f40: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1f50: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1f60: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1f70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f tls::socket -fro
1f80: 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d boz} msg] $msg.}
1f90: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
1fa0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
1fb0: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
1fc0: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
1fd0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e ..test socket-1.
1fe0: 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 9 {arg parsing f
1ff0: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2000: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2010: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2020: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2030: 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 er foo -myport 2
2040: 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 20 24 521 3333} msg] $
2050: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2060: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2070: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
2080: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
2090: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
20a0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e ..test socket-1.
20b0: 31 30 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 10 {arg parsing
20c0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
20d0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
20e0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
20f0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 74 tls::socket host
2100: 20 32 35 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 67 2528 -junk} msg
2110: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
2120: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
2130: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
2140: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
2150: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 port"}}..test s
2160: 6f 63 6b 65 74 2d 31 2e 31 31 20 7b 61 72 67 20 ocket-1.11 {arg
2170: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
2180: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2190: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
21a0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
21b0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 61 6c 6c ket -server call
21c0: 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d 20 6d 73 back 2520 --} ms
21d0: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
21e0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
21f0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2200: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
2210: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
2220: 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 t"}}..test socke
2230: 74 2d 31 2e 31 32 20 7b 61 72 67 20 70 61 72 73 t-1.12 {arg pars
2240: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
2250: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
2260: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
2270: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2280: 66 6f 6f 20 62 61 64 70 6f 72 74 7d 20 6d 73 67 foo badport} msg
2290: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 65 78 70 ] $msg.} {1 {exp
22a0: 65 63 74 65 64 20 69 6e 74 65 67 65 72 20 62 75 ected integer bu
22b0: 74 20 67 6f 74 20 22 62 61 64 70 6f 72 74 22 7d t got "badport"}
22c0: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 }..test socket-2
22d0: 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .1 {tcp connecti
22e0: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 on} {socket stdi
22f0: 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 o pcCrash} {.
2300: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
2310: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
2320: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
2330: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
2340: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
2350: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
2360: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
2370: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
2380: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
2390: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
23a0: 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 2828]..proc acc
23b0: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
23c0: 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 ort} {.. glob
23d0: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
23e0: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
23f0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
2400: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
2410: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
2420: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
2430: 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 $f..puts $x.
2440: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
2450: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
2460: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
2470: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
2480: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
2490: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
24a0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
24b0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 t 127.0.0.1 2828
24c0: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
24d0: 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 set x $msg.
24e0: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
24f0: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
2500: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
2510: 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ose $msg. }.
2520: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
2530: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
2540: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
2550: 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a {ready done {}}.
2560: 0a 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 .if [info exists
2570: 20 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 port] {. inc
2580: 72 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 20 r port.} else {
2590: 0a 20 20 20 20 73 65 74 20 70 6f 72 74 20 5b 65 . set port [e
25a0: 78 70 72 20 32 30 34 38 20 2b 20 5b 70 69 64 5d xpr 2048 + [pid]
25b0: 25 31 30 32 34 5d 0a 7d 0a 74 65 73 74 20 73 6f %1024].}.test so
25c0: 63 6b 65 74 2d 32 2e 32 20 7b 74 63 70 20 63 6f cket-2.2 {tcp co
25d0: 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c nnection with cl
25e0: 69 65 6e 74 20 70 6f 72 74 20 73 70 65 63 69 66 ient port specif
25f0: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ied} {socket std
2600: 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 io pcCrash} {.
2610: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
2620: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
2630: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
2640: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
2650: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
2660: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
2670: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 er 2000 "set x d
2680: 6f 6e 65 22 5d 0a 20 20 20 20 20 20 20 20 73 65 one"]. se
2690: 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t f [tls::socket
26a0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
26b0: 32 38 32 39 5d 0a 09 70 72 6f 63 20 61 63 63 65 2829]..proc acce
26c0: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
26d0: 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 rt} {.
26e0: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
26f0: 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 puts "[ge
2700: 74 73 20 24 66 69 6c 65 5d 20 24 70 6f 72 74 22 ts $file] $port"
2710: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
2720: 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 se $file.
2730: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
2740: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
2750: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
2760: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
2770: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
2780: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2790: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
27a0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
27b0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
27c0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
27d0: 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 74 0a global port.
27e0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
27f0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 tls::socket -myp
2800: 6f 72 74 20 24 70 6f 72 74 20 31 32 37 2e 30 2e ort $port 127.0.
2810: 30 2e 31 20 32 38 32 39 7d 20 73 6f 63 6b 5d 7d 0.1 2829} sock]}
2820: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
2830: 20 24 73 6f 63 6b 0a 09 63 6c 6f 73 65 20 5b 74 $sock..close [t
2840: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
2850: 2e 30 2e 31 20 32 38 32 39 5d 0a 09 70 75 74 73 .0.1 2829]..puts
2860: 20 73 74 64 65 72 72 20 24 73 6f 63 6b 0a 20 20 stderr $sock.
2870: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
2880: 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 puts $sock he
2890: 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b llo..flush $sock
28a0: 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 . lappend
28b0: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
28c0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
28d0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
28e0: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
28f0: 5b 6c 69 73 74 20 72 65 61 64 79 20 22 68 65 6c [list ready "hel
2900: 6c 6f 20 24 70 6f 72 74 22 5d 0a 74 65 73 74 20 lo $port"].test
2910: 73 6f 63 6b 65 74 2d 32 2e 33 20 7b 74 63 70 20 socket-2.3 {tcp
2920: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
2930: 63 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 63 65 client interface
2940: 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 specified} {soc
2950: 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 ket stdio pcCras
2960: 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 h} {. removeF
2970: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
2980: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
2990: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
29a0: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
29b0: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
29c0: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
29d0: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 set x done"].
29e0: 20 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a set f [tls:
29f0: 3a 73 6f 63 6b 65 74 20 20 2d 73 65 72 76 65 72 :socket -server
2a00: 20 61 63 63 65 70 74 20 32 38 33 30 5d 0a 09 70 accept 2830]..p
2a10: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
2a20: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
2a30: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
2a40: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
2a50: 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 uts "[gets $file
2a60: 5d 20 24 61 64 64 72 22 0a 20 20 20 20 20 20 20 ] $addr".
2a70: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 close $file
2a80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
2a90: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
2aa0: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
2ab0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
2ac0: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
2ad0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2ae0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2af0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2b00: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2b10: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2b20: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
2b30: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2b40: 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 32 37 2e ket -myaddr 127.
2b50: 30 2e 30 2e 31 20 31 32 37 2e 30 2e 30 2e 31 20 0.0.1 127.0.0.1
2b60: 32 38 33 30 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 2830} sock]} {.
2b70: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f set x $so
2b80: 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ck. } else {.
2b90: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
2ba0: 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 ck hello..flush
2bb0: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 $sock. la
2bc0: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
2bd0: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
2be0: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
2bf0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2c00: 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 6c x.} {ready {hel
2c10: 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a 74 lo 127.0.0.1}}.t
2c20: 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 34 20 7b est socket-2.4 {
2c30: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 tcp connection w
2c40: 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 65 72 ith server inter
2c50: 66 61 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 face specified}
2c60: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 {socket stdio pc
2c70: 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d Crash} {. rem
2c80: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
2c90: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
2ca0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
2cb0: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
2cc0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
2cd0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
2ce0: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
2cf0: 0a 20 20 20 20 20 20 20 20 73 65 74 20 66 20 5b . set f [
2d00: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
2d10: 76 65 72 20 61 63 63 65 70 74 20 2d 6d 79 61 64 ver accept -myad
2d20: 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d dr [info hostnam
2d30: 65 5d 20 32 38 33 31 5d 0a 09 70 72 6f 63 20 61 e] 2831]..proc a
2d40: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
2d50: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
2d60: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
2d70: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
2d80: 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 [gets $file]".
2d90: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
2da0: 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 $file.
2db0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a set x done..}.
2dc0: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
2dd0: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
2de0: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
2df0: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
2e00: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
2e10: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
2e20: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
2e30: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
2e40: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
2e50: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
2e60: 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 ::socket [info h
2e70: 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 7d 20 73 ostname] 2831} s
2e80: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
2e90: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
2ea0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
2eb0: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
2ec0: 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 o..flush $sock.
2ed0: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
2ee0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
2ef0: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
2f00: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2f10: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 f. set x.} {r
2f20: 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 eady hello}.test
2f30: 20 73 6f 63 6b 65 74 2d 32 2e 35 20 7b 74 63 70 socket-2.5 {tcp
2f40: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 connection with
2f50: 20 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 redundant serve
2f60: 72 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 r port} {socket
2f70: 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b stdio pcCrash} {
2f80: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
2f90: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
2fa0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
2fb0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
2fc0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
2fd0: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
2fe0: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
2ff0: 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 20 20 20 x done"].
3000: 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 set f [tls::soc
3010: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
3020: 70 74 20 32 38 33 32 5d 0a 09 70 72 6f 63 20 61 pt 2832]..proc a
3030: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
3040: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
3050: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
3060: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
3070: 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 [gets $file]".
3080: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
3090: 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 $file.
30a0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a set x done..}.
30b0: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
30c0: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
30d0: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
30e0: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
30f0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
3100: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
3110: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
3120: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
3130: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
3140: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
3150: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
3160: 2e 31 20 32 38 33 32 7d 20 73 6f 63 6b 5d 7d 20 .1 2832} sock]}
3170: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
3180: 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 $sock. } else
3190: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
31a0: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
31b0: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
31c0: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
31d0: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
31e0: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
31f0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3200: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 set x.} {ready h
3210: 65 6c 6c 6f 7d 0a 74 65 73 74 20 73 6f 63 6b 65 ello}.test socke
3220: 74 2d 32 2e 36 20 7b 74 63 70 20 63 6f 6e 6e 65 t-2.6 {tcp conne
3230: 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 7d 20 ction} {socket}
3240: 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 {. set status
3250: 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 ok. if {![ca
3260: 74 63 68 20 7b 73 65 74 20 73 6f 63 6b 20 5b 74 tch {set sock [t
3270: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
3280: 2e 30 2e 31 20 32 38 33 33 5d 7d 5d 7d 20 7b 0a .0.1 2833]}]} {.
3290: 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 .if {![catch {ge
32a0: 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 ts $sock}]} {..
32b0: 20 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 set status br
32c0: 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 oken..}..close $
32d0: 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 73 sock. }. s
32e0: 65 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 74 et status.} ok.t
32f0: 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 37 20 7b est socket-2.7 {
3300: 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e 65 echo server, one
3310: 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 73 line} {socket s
3320: 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a tdio pcCrash} {.
3330: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
3340: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
3350: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
3360: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3370: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
3380: 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 ls..set timer [a
3390: 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 fter 2000 "set x
33a0: 20 64 6f 6e 65 22 5d 0a 09 73 65 74 20 66 20 5b done"]..set f [
33b0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
33c0: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 34 5d ver accept 2834]
33d0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
33e0: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
33f0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
3400: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
3410: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
3420: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
3430: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
3440: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
3450: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
3460: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 {s} {.. set
3470: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
3480: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
3490: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
34a0: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
34b0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
34c0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
34d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
34e0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
34f0: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
3500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3510: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
3520: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 }..}..p
3530: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3540: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3550: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3560: 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 f..puts done.
3570: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3580: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3590: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
35a0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
35b0: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
35c0: 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 $f. set s [t
35d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
35e0: 2e 30 2e 31 20 32 38 33 34 5d 0a 20 20 20 20 66 .0.1 2834]. f
35f0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
3600: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
3610: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 anslation lf.
3620: 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 puts $s "hello
3630: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop
3640: 22 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 ". after 1000
3650: 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 . set x [gets
3660: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
3670: 73 0a 20 20 20 20 73 65 74 20 79 20 5b 67 65 74 s. set y [get
3680: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
3690: 24 66 0a 20 20 20 20 6c 69 73 74 20 24 78 20 24 $f. list $x $
36a0: 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 y.} {{hello abcd
36b0: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f efghijklmnop} do
36c0: 6e 65 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 ne}..test socket
36d0: 2d 32 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 -2.8 {echo serve
36e0: 72 2c 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 r, loop 50 times
36f0: 2c 20 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 , single connect
3700: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ion} {socket std
3710: 69 6f 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 io} {. makeFi
3720: 6c 65 20 7b 0a 09 73 65 74 20 66 20 5b 74 6c 73 le {..set f [tls
3730: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
3740: 20 61 63 63 65 70 74 20 32 38 33 35 5d 0a 09 70 accept 2835]..p
3750: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
3760: 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 p} {.
3770: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
3780: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
3790: 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 o $s].
37a0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
37b0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
37c0: 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 }..proc
37d0: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
37e0: 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 global i.
37f0: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
3800: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ts $s].
3810: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
3820: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
3830: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
3840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
3850: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
3860: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
3870: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
3880: 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 } else { ..
3890: 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 incr i.
38a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 put
38b0: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
38c0: 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 }..}..set i
38d0: 20 30 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 0..puts ready..
38e0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
38f0: 20 32 30 30 30 30 20 22 73 65 74 20 78 20 64 6f 20000 "set x do
3900: 6e 65 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 ne"]..vwait x..a
3910: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
3920: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 er..close $f..pu
3930: 74 73 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 ts "done $i".
3940: 20 7d 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 } script. se
3950: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
3960: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
3970: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
3980: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
3990: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
39a0: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
39b0: 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 835]. fconfig
39c0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
39d0: 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 68 g line. catch
39e0: 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 30 {..for {set x 0
39f0: 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 } {$x < 50} {inc
3a00: 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 r x} {.. puts
3a10: 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 $s "hello abcde
3a20: 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 fghijklmnop"..
3a30: 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 20 gets $s..}.
3a40: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a }. close $s.
3a50: 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 78 catch {set x
3a60: 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 [gets $f]}.
3a70: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
3a80: 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a x.} {done 50}..
3a90: 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 39 20 test socket-2.9
3aa0: 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 {socket conflict
3ab0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
3ac0: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
3ad0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
3ae0: 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 20 r accept 2828].
3af0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
3b00: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
3b10: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
3b20: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
3b30: 6e 65 20 24 66 20 7b 74 6c 73 3a 3a 73 6f 63 6b ne $f {tls::sock
3b40: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3b50: 74 20 32 38 32 38 7d 0a 20 20 20 20 63 6c 6f 73 t 2828}. clos
3b60: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3b70: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3b80: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3b90: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3ba0: 20 67 65 74 73 20 24 66 0a 20 20 20 20 61 66 74 gets $f. aft
3bb0: 65 72 20 31 30 30 0a 20 20 20 20 73 65 74 20 78 er 100. set x
3bc0: 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 63 [list [catch {c
3bd0: 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d 20 24 6d lose $f} msg] $m
3be0: 73 67 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 sg]. close $s
3bf0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 . set x.} {1
3c00: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
3c10: 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 ocket: address a
3c20: 6c 72 65 61 64 79 20 69 6e 20 75 73 65 0a 20 20 lready in use.
3c30: 20 20 77 68 69 6c 65 20 65 78 65 63 75 74 69 6e while executin
3c40: 67 0a 22 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 g."socket -serve
3c50: 72 20 61 63 63 65 70 74 20 32 38 32 38 22 0a 20 r accept 2828".
3c60: 20 20 20 28 66 69 6c 65 20 22 73 63 72 69 70 74 (file "script
3c70: 22 20 6c 69 6e 65 20 31 29 7d 7d 0a 0a 74 65 73 " line 1)}}..tes
3c80: 74 20 73 6f 63 6b 65 74 2d 32 2e 31 30 20 7b 63 t socket-2.10 {c
3c90: 6c 6f 73 65 20 6f 6e 20 61 63 63 65 70 74 2c 20 lose on accept,
3ca0: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 accepted socket
3cb0: 6c 69 76 65 73 7d 20 7b 73 6f 63 6b 65 74 20 70 lives} {socket p
3cc0: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 cCrash} {. se
3cd0: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 t done 0. set
3ce0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
3cf0: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
3d00: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 med_out"]. se
3d10: 74 20 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t ss [tls::socke
3d20: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3d30: 20 32 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 2830]. proc
3d40: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
3d50: 0a 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 6c 6f ..global ss..clo
3d60: 73 65 20 24 73 73 0a 09 66 69 6c 65 65 76 65 6e se $ss..fileeven
3d70: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
3d80: 65 61 64 69 74 20 24 73 22 0a 09 66 63 6f 6e 66 eadit $s"..fconf
3d90: 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 20 igure $s -trans
3da0: 6c 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f lf. }. pro
3db0: 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 c readit {s} {..
3dc0: 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 65 74 global done..get
3dd0: 73 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 0a 09 s $s..close $s..
3de0: 73 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 20 7d set done 1. }
3df0: 0a 20 20 20 20 73 65 74 20 63 73 20 5b 74 6c 73 . set cs [tls
3e00: 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 ::socket [info h
3e10: 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d 0a 20 ostname] 2830].
3e20: 20 20 20 70 75 74 73 20 24 63 73 20 68 65 6c 6c puts $cs hell
3e30: 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a o. close $cs.
3e40: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
3e50: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
3e60: 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 20 64 $timer. set d
3e70: 6f 6e 65 0a 7d 20 31 0a 74 65 73 74 20 73 6f 63 one.} 1.test soc
3e80: 6b 65 74 2d 32 2e 31 31 20 7b 64 65 74 65 63 74 ket-2.11 {detect
3e90: 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 7b 73 ing new data} {s
3ea0: 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b ocket pcCrash} {
3eb0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
3ec0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 {s a p} {..glob
3ed0: 61 6c 20 73 6f 63 6b 0a 09 73 65 74 20 73 6f 63 al sock..set soc
3ee0: 6b 20 24 73 0a 20 20 20 20 7d 0a 0a 20 20 20 20 k $s. }..
3ef0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
3f00: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
3f10: 74 20 32 34 30 30 5d 0a 20 20 20 20 73 65 74 20 t 2400]. set
3f20: 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 65 74 20 sock "". set
3f30: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
3f40: 31 32 37 2e 30 2e 30 2e 31 20 32 34 30 30 5d 0a 127.0.0.1 2400].
3f50: 20 20 20 20 76 77 61 69 74 20 73 6f 63 6b 0a 20 vwait sock.
3f60: 20 20 20 70 75 74 73 20 24 73 32 20 6f 6e 65 0a puts $s2 one.
3f70: 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 flush $s2.
3f80: 20 20 61 66 74 65 72 20 35 30 30 0a 20 20 20 20 after 500.
3f90: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
3fa0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 -blocking 0.
3fb0: 20 73 65 74 20 72 65 73 75 6c 74 20 5b 67 65 74 set result [get
3fc0: 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 s $sock]. lap
3fd0: 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 67 65 74 pend result [get
3fe0: 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f s $sock]. fco
3ff0: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 nfigure $sock -b
4000: 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 70 75 locking 1. pu
4010: 74 73 20 24 73 32 20 74 77 6f 0a 20 20 20 20 66 ts $s2 two. f
4020: 6c 75 73 68 20 24 73 32 0a 20 20 20 20 66 63 6f lush $s2. fco
4030: 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 nfigure $sock -b
4040: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 6c 61 locking 0. la
4050: 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 67 65 ppend result [ge
4060: 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 ts $sock]. fc
4070: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
4080: 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 blocking 1. c
4090: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
40a0: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
40b0: 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 65 $sock. set re
40c0: 73 75 6c 74 0a 7d 20 7b 6f 6e 65 20 7b 7d 20 74 sult.} {one {} t
40d0: 77 6f 7d 0a 0a 0a 74 65 73 74 20 73 6f 63 6b 65 wo}...test socke
40e0: 74 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 63 6f t-3.1 {socket co
40f0: 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 nflict} {socket
4100: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
4110: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
4120: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
4130: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
4140: 73 20 24 66 20 7b 0a 09 73 65 74 20 66 20 5b 74 s $f {..set f [t
4150: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4160: 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a er accept 2828].
4170: 09 70 75 74 73 20 72 65 61 64 79 0a 09 67 65 74 .puts ready..get
4180: 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 s stdin..close $
4190: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
41a0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
41b0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
41c0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
41d0: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
41e0: 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 gets $f. se
41f0: 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 t x [list [catch
4200: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
4210: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
4220: 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 67 8} msg] \...$msg
4230: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 62 79 ]. puts $f by
4240: 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 e. close $f.
4250: 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 set x.} {1 {c
4260: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
4270: 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 ket: address alr
4280: 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 eady in use}}..t
4290: 65 73 74 20 73 6f 63 6b 65 74 2d 33 2e 32 20 7b est socket-3.2 {
42a0: 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 server with seve
42b0: 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f ral clients} {so
42c0: 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 cket stdio pcCra
42d0: 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 sh} {. remove
42e0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
42f0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
4300: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
4310: 66 20 7b 0a 09 73 65 74 20 74 31 20 5b 61 66 74 f {..set t1 [aft
4320: 65 72 20 33 30 30 30 30 20 22 73 65 74 20 78 20 er 30000 "set x
4330: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 timed_out"]..set
4340: 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 t2 [after 31000
4350: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
4360: 74 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 66 74 t"]..set t3 [aft
4370: 65 72 20 33 32 30 30 30 20 22 73 65 74 20 78 20 er 32000 "set x
4380: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 timed_out"]..set
4390: 20 63 6f 75 6e 74 65 72 20 30 0a 09 73 65 74 20 counter 0..set
43a0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
43b0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
43c0: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
43d0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
43e0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
43f0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
4400: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
4410: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
4420: 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 ng line..}..proc
4430: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
4440: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
4450: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
4460: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
4470: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
4480: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
4490: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
44a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44b0: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
44c0: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
44d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
44e0: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
44f0: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
4500: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
4510: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
4520: 6c 20 24 74 31 0a 09 76 77 61 69 74 20 78 0a 09 l $t1..vwait x..
4530: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 after cancel $t2
4540: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
4550: 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f cancel $t3..clo
4560: 73 65 20 24 73 0a 09 70 75 74 73 20 24 78 0a 20 se $s..puts $x.
4570: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
4580: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
4590: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
45a0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
45b0: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 73 ript]" r+]. s
45c0: 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 et x [gets $f].
45d0: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
45e0: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
45f0: 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 2828]. fconf
4600: 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 igure $s1 -buffe
4610: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
4620: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
4630: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 t 127.0.0.1 2828
4640: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4650: 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 $s2 -buffering
4660: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 line. set s3
4670: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
4680: 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 .0.0.1 2828].
4690: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 20 fconfigure $s3
46a0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
46b0: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
46c0: 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e } {$i < 100} {in
46d0: 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 cr i} {..puts $s
46e0: 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 1 hello,s1..gets
46f0: 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 $s1..puts $s2 h
4700: 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 73 ello,s2..gets $s
4710: 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 2..puts $s3 hell
4720: 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 o,s3..gets $s3.
4730: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
4740: 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 s1. close $s2
4750: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 . close $s3.
4760: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
4770: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
4780: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
4790: 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 {ready done}..te
47a0: 73 74 20 73 6f 63 6b 65 74 2d 34 2e 31 20 7b 73 st socket-4.1 {s
47b0: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
47c0: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 al clients} {soc
47d0: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
47e0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
47f0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
4800: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
4810: 20 70 75 74 73 20 24 66 20 7b 0a 09 67 65 74 73 puts $f {..gets
4820: 20 73 74 64 69 6e 0a 09 73 65 74 20 73 20 5b 73 stdin..set s [s
4830: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
4840: 32 38 32 38 5d 0a 09 66 63 6f 6e 66 69 67 75 72 2828]..fconfigur
4850: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
4860: 6c 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 20 69 line..for {set i
4870: 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 0} {$i < 100} {
4880: 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 70 incr i} {.. p
4890: 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 20 20 uts $s hello..
48a0: 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 63 6c gets $s..}..cl
48b0: 6f 73 65 20 24 73 0a 09 70 75 74 73 20 62 79 65 ose $s..puts bye
48c0: 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 ..gets stdin.
48d0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
48e0: 20 20 20 20 73 65 74 20 70 31 20 5b 6f 70 65 6e set p1 [open
48f0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
4900: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
4910: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 ipt]" r+]. fc
4920: 6f 6e 66 69 67 75 72 65 20 24 70 31 20 2d 62 75 onfigure $p1 -bu
4930: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
4940: 20 73 65 74 20 70 32 20 5b 6f 70 65 6e 20 22 7c set p2 [open "|
4950: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
4960: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
4970: 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 ]" r+]. fconf
4980: 69 67 75 72 65 20 24 70 32 20 2d 62 75 66 66 65 igure $p2 -buffe
4990: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
49a0: 74 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 t p3 [open "|[li
49b0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
49c0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
49d0: 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 r+]. fconfigu
49e0: 72 65 20 24 70 33 20 2d 62 75 66 66 65 72 69 6e re $p3 -bufferin
49f0: 67 20 6c 69 6e 65 0a 20 20 20 20 70 72 6f 63 20 g line. proc
4a00: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
4a10: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
4a20: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4a30: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
4a40: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
4a50: 6f 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 o $s]. }.
4a60: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
4a70: 09 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 .global x.
4a80: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
4a90: 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 ]. if {[e
4aa0: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
4ab0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
4ac0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
4ad0: 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 7d 20 done. }
4ae0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 else {.
4af0: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
4b00: 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 }. }.
4b10: 20 20 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 set t1 [after
4b20: 33 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 30000 "set x tim
4b30: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 ed_out"]. set
4b40: 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 t2 [after 31000
4b50: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
4b60: 74 22 5d 0a 20 20 20 20 73 65 74 20 74 33 20 5b t"]. set t3 [
4b70: 61 66 74 65 72 20 33 32 30 30 30 20 22 73 65 74 after 32000 "set
4b80: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
4b90: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
4ba0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4bb0: 63 65 70 74 20 32 38 32 38 5d 0a 20 20 20 20 70 cept 2828]. p
4bc0: 75 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 uts $p1 open.
4bd0: 20 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 puts $p2 open.
4be0: 20 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e puts $p3 open
4bf0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
4c00: 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 vwait x. vwa
4c10: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
4c20: 61 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 ancel $t1. af
4c30: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 ter cancel $t2.
4c40: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
4c50: 24 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $t3. close $s
4c60: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
4c70: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
4c80: 74 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 t p1 [gets $p1]
4c90: 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $x]. lappend
4ca0: 6c 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 l [list p2 [gets
4cb0: 20 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 $p2] $x]. la
4cc0: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 ppend l [list p3
4cd0: 20 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a [gets $p3] $x].
4ce0: 20 20 20 20 70 75 74 73 20 24 70 31 20 62 79 65 puts $p1 bye
4cf0: 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 62 79 . puts $p2 by
4d00: 65 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 62 e. puts $p3 b
4d10: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 ye. close $p1
4d20: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 . close $p2.
4d30: 20 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 close $p3.
4d40: 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 set l.} {{p1 by
4d50: 65 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 e done} {p2 bye
4d60: 64 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f done} {p3 bye do
4d70: 6e 65 7d 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 ne}}.test socket
4d80: 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 -4.2 {byte order
4d90: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
4da0: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
4db0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
4dc0: 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 set x ok. if
4dd0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
4de0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
4df0: 64 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d do 0x3000} msg]}
4e00: 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 {..set x $msg.
4e10: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f } else {..clo
4e20: 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 se $msg. }.
4e30: 20 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 set x.} ok..te
4e40: 73 74 20 73 6f 63 6b 65 74 2d 35 2e 31 20 7b 62 st socket-5.1 {b
4e50: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
4e60: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
4e70: 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 rs, htons} \..{s
4e80: 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e ocket unixOnly n
4e90: 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 otRoot} {. se
4ea0: 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 t x {couldn't op
4eb0: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
4ec0: 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b wner}. if {![
4ed0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
4ee0: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
4ef0: 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 0x1} msg]} {.
4f00: 20 20 20 20 20 73 65 74 20 78 20 7b 68 74 6f 6e set x {hton
4f10: 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c s problem, shoul
4f20: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c d be disallowed,
4f30: 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 are you running
4f40: 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 as SU?}..close
4f50: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
4f60: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
4f70: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
4f80: 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74 20 73 6f t owner}.test so
4f90: 63 6b 65 74 2d 35 2e 32 20 7b 62 79 74 65 20 6f cket-5.2 {byte o
4fa0: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
4fb0: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
4fc0: 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b tons} {socket} {
4fd0: 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c . set x {coul
4fe0: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
4ff0: 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f : port number to
5000: 6f 20 68 69 67 68 7d 0a 20 20 20 20 69 66 20 7b o high}. if {
5010: 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f ![catch {tls::so
5020: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
5030: 6f 20 30 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d o 0x10000} msg]}
5040: 20 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 74 20 {..set x {port
5050: 72 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c resolution probl
5060: 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 em, should be di
5070: 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 sallowed}..close
5080: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
5090: 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 set x.} {couldn'
50a0: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
50b0: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
50c0: 69 67 68 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 igh}.test socket
50d0: 2d 35 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 72 -5.3 {byte order
50e0: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
50f0: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
5100: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 } \..{socket uni
5110: 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b xOnly notRoot} {
5120: 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c . set x {coul
5130: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
5140: 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 : not owner}.
5150: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c if {![catch {tl
5160: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5170: 72 20 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d 7d r dodo 21} msg]}
5180: 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 {..set x {htons
5190: 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 problem, should
51a0: 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 be disallowed,
51b0: 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 are you running
51c0: 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 as SU?}..close $
51d0: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 msg. }. se
51e0: 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 t x.} {couldn't
51f0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 open socket: not
5200: 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 20 73 6f owner}..test so
5210: 63 6b 65 74 2d 36 2e 31 20 7b 61 63 63 65 70 74 cket-6.1 {accept
5220: 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d callback error}
5230: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
5240: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
5250: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
5260: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
5270: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
5280: 09 67 65 74 73 20 73 74 64 69 6e 0a 09 74 6c 73 .gets stdin..tls
5290: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
52a0: 2e 31 20 32 38 34 38 0a 20 20 20 20 7d 0a 20 20 .1 2848. }.
52b0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
52c0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
52d0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
52e0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
52f0: 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 r+]. proc bge
5300: 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f rror args {..glo
5310: 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 bal x..set x $ar
5320: 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f gs. }. pro
5330: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
5340: 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 {expr 10 / 0}.
5350: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
5360: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
5370: 63 65 70 74 20 32 38 34 38 5d 0a 20 20 20 20 70 cept 2848]. p
5380: 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 uts $f hello.
5390: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
53a0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
53b0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
53c0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
53d0: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
53e0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
53f0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e close $s. ren
5400: 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 ame bgerror {}.
5410: 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 set x.} {{div
5420: 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 ide by zero}}..t
5430: 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 31 20 7b est socket-7.1 {
5440: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
5450: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
5460: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
5470: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
5480: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
5490: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
54a0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
54b0: 09 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 .tls::socket -se
54c0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 30 rver accept 2820
54d0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 ..proc accept ar
54e0: 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c gs {.. global
54f0: 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f x.. set x do
5500: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
5510: 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 y..set timer [af
5520: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
5530: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 timed_out"]..vw
5540: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
5550: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d cel $timer. }
5560: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
5570: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
5580: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
5590: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
55a0: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
55b0: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
55c0: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
55d0: 2e 31 20 32 38 32 30 5d 0a 20 20 20 20 73 65 74 .1 2820]. set
55e0: 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 p [fconfigure $
55f0: 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 s -peername].
5600: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
5610: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c ose $f. set l
5620: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
5630: 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 l [string compar
5640: 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 20 e [lindex $p 0]
5650: 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 127.0.0.1]. l
5660: 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 append l [string
5670: 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 compare [lindex
5680: 20 24 70 20 32 5d 20 32 38 32 30 5d 0a 20 20 20 $p 2] 2820].
5690: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e lappend l [llen
56a0: 67 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20 33 gth $p].} {0 0 3
56b0: 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e }.test socket-7.
56c0: 32 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 2 {testing socke
56d0: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
56e0: 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ns} {socket stdi
56f0: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
5700: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
5710: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
5720: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
5730: 20 7b 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 {..tls::socket
5740: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
5750: 38 32 31 0a 09 70 72 6f 63 20 61 63 63 65 70 74 821..proc accept
5760: 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f args {.. glo
5770: 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 bal x.. set x
5780: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
5790: 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 eady..set timer
57a0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
57b0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
57c0: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
57d0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
57e0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
57f0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5800: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
5810: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
5820: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
5830: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
5840: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
5850: 30 2e 30 2e 31 20 32 38 32 31 5d 0a 20 20 20 20 0.0.1 2821].
5860: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
5870: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
5880: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
5890: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
58a0: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
58b0: 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 nd l [llength $p
58c0: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
58d0: 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a 20 20 [lindex $p 0].
58e0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 65 78 70 lappend l [exp
58f0: 72 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 r [lindex $p 2]
5900: 3d 3d 20 32 38 32 31 5d 0a 7d 20 7b 33 20 31 32 == 2821].} {3 12
5910: 37 2e 30 2e 30 2e 31 20 30 7d 0a 74 65 73 74 20 7.0.0.1 0}.test
5920: 73 6f 63 6b 65 74 2d 37 2e 33 20 7b 74 65 73 74 socket-7.3 {test
5930: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
5940: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
5950: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
5960: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
5970: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
5980: 32 32 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 66 22]. set l [f
5990: 63 6f 6e 66 69 67 75 72 65 20 24 73 5d 0a 20 20 configure $s].
59a0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 close $s. u
59b0: 70 64 61 74 65 0a 20 20 20 20 6c 6c 65 6e 67 74 pdate. llengt
59c0: 68 20 24 6c 0a 7d 20 31 32 0a 74 65 73 74 20 73 h $l.} 12.test s
59d0: 6f 63 6b 65 74 2d 37 2e 34 20 7b 74 65 73 74 69 ocket-7.4 {testi
59e0: 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 ng socket specif
59f0: 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 ic options} {soc
5a00: 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 ket pcCrash} {.
5a10: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
5a20: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
5a30: 63 65 70 74 20 32 38 32 33 5d 0a 20 20 20 20 70 cept 2823]. p
5a40: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
5a50: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 p} {..global x..
5a60: 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 set x [fconfigur
5a70: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
5a80: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
5a90: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
5aa0: 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f :socket [info ho
5ab0: 73 74 6e 61 6d 65 5d 20 32 38 32 33 5d 0a 20 20 stname] 2823].
5ac0: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
5ad0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
5ae0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
5af0: 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 vwait x. afte
5b00: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
5b10: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
5b20: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 close $s1. s
5b30: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
5b40: 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 end l [lindex $x
5b50: 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 2] [llength $x]
5b60: 0a 7d 20 7b 32 38 32 33 20 33 7d 0a 0a 74 65 73 .} {2823 3}..tes
5b70: 74 20 73 6f 63 6b 65 74 2d 37 2e 35 20 7b 74 65 t socket-7.5 {te
5b80: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
5b90: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
5ba0: 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 63 20 socket unixOrPc
5bb0: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 pcCrash} {. s
5bc0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
5bd0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
5be0: 20 32 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 2829]. proc
5bf0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
5c00: 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 ..global x..set
5c10: 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 x [fconfigure $s
5c20: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f -sockname]..clo
5c30: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
5c40: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
5c50: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
5c60: 32 39 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 29]. set time
5c70: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
5c80: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5c90: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
5ca0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
5cb0: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
5cc0: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
5cd0: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
5ce0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
5cf0: 64 65 78 20 24 78 20 30 5d 20 5b 6c 69 6e 64 65 dex $x 0] [linde
5d00: 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 x $x 2] [llength
5d10: 20 24 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e 30 2e $x].} {127.0.0.
5d20: 31 20 32 38 32 39 20 33 7d 0a 0a 74 65 73 74 20 1 2829 3}..test
5d30: 73 6f 63 6b 65 74 2d 38 2e 31 20 7b 74 65 73 74 socket-8.1 {test
5d40: 69 6e 67 20 2d 61 73 79 6e 63 20 66 6c 61 67 20 ing -async flag
5d50: 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 on sockets} {soc
5d60: 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 ket pcCrash} {.
5d70: 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 73 20 # NOTE: This
5d80: 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 6f 6e test may fail on
5d90: 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 32 2e some Solaris 2.
5da0: 34 20 73 79 73 74 65 6d 73 2e 20 49 66 20 69 74 4 systems. If it
5db0: 20 64 6f 65 73 2c 0a 20 20 20 20 23 20 63 68 65 does,. # che
5dc0: 63 6b 20 74 68 61 74 20 79 6f 75 20 68 61 76 65 ck that you have
5dd0: 20 74 68 65 73 65 20 70 61 74 63 68 65 73 20 69 these patches i
5de0: 6e 73 74 61 6c 6c 65 64 20 28 75 73 69 6e 67 20 nstalled (using
5df0: 73 68 6f 77 72 65 76 20 2d 70 29 3a 0a 20 20 20 showrev -p):.
5e00: 20 23 0a 20 20 20 20 23 20 31 30 31 39 30 37 2d #. # 101907-
5e10: 30 35 2c 20 31 30 31 39 32 35 2d 30 32 2c 20 31 05, 101925-02, 1
5e20: 30 31 39 34 35 2d 31 34 2c 20 31 30 31 39 35 39 01945-14, 101959
5e30: 2d 30 33 2c 20 31 30 31 39 36 39 2d 30 35 2c 20 -03, 101969-05,
5e40: 31 30 31 39 37 33 2d 30 33 2c 0a 20 20 20 20 23 101973-03,. #
5e50: 20 31 30 31 39 37 37 2d 30 33 2c 20 31 30 31 39 101977-03, 1019
5e60: 38 31 2d 30 32 2c 20 31 30 31 39 38 35 2d 30 31 81-02, 101985-01
5e70: 2c 20 31 30 32 30 30 31 2d 30 33 2c 20 31 30 32 , 102001-03, 102
5e80: 30 30 33 2d 30 31 2c 20 31 30 32 30 30 37 2d 30 003-01, 102007-0
5e90: 31 2c 0a 20 20 20 20 23 20 31 30 32 30 31 31 2d 1,. # 102011-
5ea0: 30 32 2c 20 31 30 32 30 32 34 2d 30 31 2c 20 31 02, 102024-01, 1
5eb0: 30 32 30 33 39 2d 30 31 2c 20 31 30 32 30 34 34 02039-01, 102044
5ec0: 2d 30 31 2c 20 31 30 32 30 34 38 2d 30 31 2c 20 -01, 102048-01,
5ed0: 31 30 32 30 36 32 2d 30 33 2c 0a 20 20 20 20 23 102062-03,. #
5ee0: 20 31 30 32 30 36 36 2d 30 34 2c 20 31 30 32 30 102066-04, 1020
5ef0: 37 30 2d 30 31 2c 20 31 30 32 31 30 35 2d 30 31 70-01, 102105-01
5f00: 2c 20 31 30 32 31 35 33 2d 30 33 2c 20 31 30 32 , 102153-03, 102
5f10: 32 31 36 2d 30 31 2c 20 31 30 32 32 33 32 2d 30 216-01, 102232-0
5f20: 31 2c 0a 20 20 20 20 23 20 31 30 31 38 37 38 2d 1,. # 101878-
5f30: 30 33 2c 20 31 30 31 38 37 39 2d 30 31 2c 20 31 03, 101879-01, 1
5f40: 30 31 38 38 30 2d 30 33 2c 20 31 30 31 39 33 33 01880-03, 101933
5f50: 2d 30 31 2c 20 31 30 31 39 35 30 2d 30 31 2c 20 -01, 101950-01,
5f60: 31 30 32 30 33 30 2d 30 31 2c 0a 20 20 20 20 23 102030-01,. #
5f70: 20 31 30 32 30 35 37 2d 30 38 2c 20 31 30 32 31 102057-08, 1021
5f80: 34 30 2d 30 31 2c 20 31 30 31 39 32 30 2d 30 32 40-01, 101920-02
5f90: 2c 20 31 30 31 39 32 31 2d 30 39 2c 20 31 30 31 , 101921-09, 101
5fa0: 39 32 32 2d 30 37 2c 20 31 30 31 39 32 33 2d 30 922-07, 101923-0
5fb0: 33 0a 20 20 20 20 23 0a 20 20 20 20 23 20 49 66 3. #. # If
5fc0: 20 61 66 74 65 72 20 69 6e 73 74 61 6c 6c 69 6e after installin
5fd0: 67 20 74 68 65 73 65 20 70 61 74 63 68 65 73 20 g these patches
5fe0: 79 6f 75 20 61 72 65 20 73 74 69 6c 6c 20 65 78 you are still ex
5ff0: 70 65 72 69 65 6e 63 69 6e 67 20 61 0a 20 20 20 periencing a.
6000: 20 23 20 70 72 6f 62 6c 65 6d 2c 20 70 6c 65 61 # problem, plea
6010: 73 65 20 65 6d 61 69 6c 20 6a 79 6c 40 65 6e 67 se email jyl@eng
6020: 2e 73 75 6e 2e 63 6f 6d 2e 20 57 65 20 68 61 76 .sun.com. We hav
6030: 65 20 6e 6f 74 20 6f 62 73 65 72 76 65 64 20 74 e not observed t
6040: 68 69 73 0a 20 20 20 20 23 20 66 61 69 6c 75 72 his. # failur
6050: 65 20 6f 6e 20 53 6f 6c 61 72 69 73 20 32 2e 35 e on Solaris 2.5
6060: 2c 20 73 6f 20 61 6e 6f 74 68 65 72 20 6f 70 74 , so another opt
6070: 69 6f 6e 20 28 69 6e 73 74 65 61 64 20 6f 66 20 ion (instead of
6080: 69 6e 73 74 61 6c 6c 69 6e 67 0a 20 20 20 20 23 installing. #
6090: 20 74 68 65 73 65 20 70 61 74 63 68 65 73 29 20 these patches)
60a0: 69 73 20 74 6f 20 75 70 67 72 61 64 65 20 74 6f is to upgrade to
60b0: 20 53 6f 6c 61 72 69 73 20 32 2e 35 2e 0a 20 20 Solaris 2.5..
60c0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
60d0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
60e0: 65 70 74 20 32 38 33 30 5d 0a 20 20 20 20 70 72 ept 2830]. pr
60f0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
6100: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 70 } {..global x..p
6110: 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 uts $s bye..clos
6120: 65 20 24 73 0a 09 73 65 74 20 78 20 64 6f 6e 65 e $s..set x done
6130: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
6140: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 1 [tls::socket -
6150: 61 73 79 6e 63 20 5b 69 6e 66 6f 20 68 6f 73 74 async [info host
6160: 6e 61 6d 65 5d 20 32 38 33 30 5d 0a 20 20 20 20 name] 2830].
6170: 76 77 61 69 74 20 78 0a 20 20 20 20 73 65 74 20 vwait x. set
6180: 7a 20 5b 67 65 74 73 20 24 73 31 5d 0a 20 20 20 z [gets $s1].
6190: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
61a0: 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 ose $s1. set
61b0: 7a 0a 7d 20 62 79 65 0a 0a 74 65 73 74 20 73 6f z.} bye..test so
61c0: 63 6b 65 74 2d 39 2e 31 20 7b 74 65 73 74 69 6e cket-9.1 {testin
61d0: 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 g spurious event
61e0: 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 s} {socket pcCra
61f0: 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 sh} {. set le
6200: 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 n 0. set spur
6210: 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 ious 0. set d
6220: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 one 0. proc r
6230: 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a eadlittle {s} {.
6240: 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 .global spurious
6250: 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c done len..set l
6260: 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 [read $s 1]..if
6270: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
6280: 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 $l] == 0} {..
6290: 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d if {![eof $s]}
62a0: 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f {...incr spurio
62b0: 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b us.. } else {
62c0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
62d0: 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a t done 1.. }.
62e0: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 .} else {.. i
62f0: 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 ncr len [string
6300: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 length $l]..}.
6310: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
6320: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
6330: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
6340: 66 66 65 72 69 6e 67 20 6e 6f 6e 65 20 2d 62 6c ffering none -bl
6350: 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 66 69 6c 65 ocking off..file
6360: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
6370: 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 74 e [list readlitt
6380: 6c 65 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 le $s]. }.
6390: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
63a0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
63b0: 70 74 20 32 38 33 31 5d 0a 20 20 20 20 73 65 74 pt 2831]. set
63c0: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
63d0: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
63e0: 32 38 33 31 5d 0a 20 20 20 20 70 75 74 73 20 2d 2831]. puts -
63f0: 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 30 31 32 nonewline $c 012
6400: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
6410: 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 9012345678901234
6420: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 0a 567890123456789.
6430: 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 close $c.
6440: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
6450: 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 10000 "set don
6460: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
6470: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
6480: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
6490: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
64a0: 73 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 s. list $spur
64b0: 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 ious $len.} {0 5
64c0: 30 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 0}..test socket-
64d0: 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 61 73 79 9.2 {testing asy
64e0: 6e 63 20 77 72 69 74 65 2c 20 66 69 6c 65 65 76 nc write, fileev
64f0: 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f 6e 20 63 ents, flush on c
6500: 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 74 20 70 63 lose} {socket pc
6510: 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 Crash} {. set
6520: 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a 20 firstblock "".
6530: 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d for {set i 0}
6540: 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 20 {$i < 5} {incr
6550: 69 7d 20 7b 73 65 74 20 66 69 72 73 74 62 6c 6f i} {set firstblo
6560: 63 6b 20 22 61 24 66 69 72 73 74 62 6c 6f 63 6b ck "a$firstblock
6570: 24 66 69 72 73 74 62 6c 6f 63 6b 22 7d 0a 20 20 $firstblock"}.
6580: 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 set secondbloc
6590: 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 k "". for {se
65a0: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d t i 0} {$i < 16}
65b0: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 73 65 74 {incr i} {..set
65c0: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 secondblock "b$
65d0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f secondblock$seco
65e0: 6e 64 62 6c 6f 63 6b 22 0a 20 20 20 20 7d 0a 20 ndblock". }.
65f0: 20 20 20 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 set l [tls::s
6600: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
6610: 63 65 70 74 20 32 38 33 32 5d 0a 20 20 20 20 70 cept 2832]. p
6620: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
6630: 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 p} {..fconfigure
6640: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
6650: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 -translation lf
6660: 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 -buffersize 1638
6670: 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 4 \...-buffering
6680: 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 line..fileevent
6690: 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 $s readable "re
66a0: 61 64 61 62 6c 65 20 24 73 22 0a 20 20 20 20 7d adable $s". }
66b0: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 62 . proc readab
66c0: 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 le {s} {..set l
66d0: 5b 67 65 74 73 20 24 73 5d 0a 09 66 69 6c 65 65 [gets $s]..filee
66e0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
66f0: 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 30 20 {}..after 1000
6700: 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 20 7d respond $s. }
6710: 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 6f 6e . proc respon
6720: 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 d {s} {..global
6730: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 70 75 74 73 firstblock..puts
6740: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
6750: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 74 65 firstblock..afte
6760: 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 r 1000 writedata
6770: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s. }. pr
6780: 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d oc writedata {s}
6790: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 6f 6e {..global secon
67a0: 64 62 6c 6f 63 6b 0a 09 70 75 74 73 20 2d 6e 6f dblock..puts -no
67b0: 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f newline $s $seco
67c0: 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 ndblock..close $
67d0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
67e0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b s [tls::socket [
67f0: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 info hostname] 2
6800: 38 33 32 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 832]. fconfig
6810: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
6820: 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 0 -trans lf -bu
6830: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
6840: 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 set count 0.
6850: 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 puts $s hello.
6860: 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b proc readit {
6870: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
6880: 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b nt done..set l [
6890: 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 read $s]..incr c
68a0: 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e ount [string len
68b0: 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f gth $l]..if {[eo
68c0: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c f $s]} {.. cl
68d0: 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 ose $s.. set
68e0: 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a done 1..}. }.
68f0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
6900: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 readable "readi
6910: 74 20 24 73 22 0a 20 20 20 20 73 65 74 20 74 69 t $s". set ti
6920: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
6930: 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 "set done timed
6940: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
6950: 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 done. after
6960: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6970: 20 20 63 6c 6f 73 65 20 24 6c 0a 20 20 20 20 73 close $l. s
6980: 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 36 36 et count.} 65566
6990: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 39 2e ..test socket-9.
69a0: 33 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 3 {testing EOF s
69b0: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 73 6f 63 6b tickyness} {sock
69c0: 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 et pcCrash} {.
69d0: 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f proc count_to_
69e0: 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 eof {s} {..globa
69f0: 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d l count done tim
6a00: 65 72 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 er..set l [gets
6a10: 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 $s]..if {[eof $s
6a20: 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 ]} {.. incr c
6a30: 6f 75 6e 74 0a 09 20 20 20 20 69 66 20 7b 24 63 ount.. if {$c
6a40: 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c ount > 9} {...cl
6a50: 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e ose $s...set don
6a60: 65 20 74 72 75 65 0a 09 09 73 65 74 20 63 6f 75 e true...set cou
6a70: 6e 74 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b nt {eof is stick
6a80: 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 y}...after cance
6a90: 6c 20 24 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a l $timer.. }.
6aa0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f .}. }. pro
6ab0: 63 20 74 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b c timerproc {} {
6ac0: 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f ..global done co
6ad0: 75 6e 74 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 unt c..set done
6ae0: 74 72 75 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 true..set count
6af0: 7b 74 69 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c {timer went off,
6b00: 20 65 6f 66 20 69 73 20 6e 6f 74 20 73 74 69 63 eof is not stic
6b10: 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 ky}..close $c.
6b20: 20 20 7d 09 0a 20 20 20 20 73 65 74 20 63 6f 75 }.. set cou
6b30: 6e 74 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e nt 0. set don
6b40: 65 20 66 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 e false. proc
6b50: 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 write_then_clos
6b60: 65 20 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 e {s} {..puts $s
6b70: 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 bye..close $s.
6b80: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 }. proc ac
6b90: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
6ba0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
6bb0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
6bc0: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 ranslation lf..f
6bd0: 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 ileevent $s writ
6be0: 61 62 6c 65 20 22 77 72 69 74 65 5f 74 68 65 6e able "write_then
6bf0: 5f 63 6c 6f 73 65 20 24 73 22 0a 20 20 20 20 7d _close $s". }
6c00: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6c10: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6c20: 61 63 63 65 70 74 20 32 38 33 33 5d 0a 20 20 20 accept 2833].
6c30: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
6c40: 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 ket [info hostna
6c50: 6d 65 5d 20 32 38 33 33 5d 0a 20 20 20 20 66 63 me] 2833]. fc
6c60: 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f onfigure $c -blo
6c70: 63 6b 69 6e 67 20 6f 66 66 20 2d 62 75 66 66 65 cking off -buffe
6c80: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
6c90: 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 69 lation lf. fi
6ca0: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
6cb0: 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f ble "count_to_eo
6cc0: 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 f $c". set ti
6cd0: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 20 mer [after 1000
6ce0: 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 76 timerproc]. v
6cf0: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 6c wait done. cl
6d00: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 63 ose $s. set c
6d10: 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 73 ount.} {eof is s
6d20: 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 ticky}..removeFi
6d30: 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 74 20 le script..test
6d40: 73 6f 63 6b 65 74 2d 31 30 2e 31 20 7b 74 65 73 socket-10.1 {tes
6d50: 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 63 65 ting socket acce
6d60: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
6d70: 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 r handling} {soc
6d80: 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 ket pcCrash} {.
6d90: 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 set goterror
6da0: 30 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 0. proc bgerr
6db0: 6f 72 20 61 72 67 73 20 7b 67 6c 6f 62 61 6c 20 or args {global
6dc0: 67 6f 74 65 72 72 6f 72 3b 20 73 65 74 20 67 6f goterror; set go
6dd0: 74 65 72 72 6f 72 20 31 7d 0a 20 20 20 20 73 65 terror 1}. se
6de0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
6df0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
6e00: 32 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 2898]. proc a
6e10: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 ccept {s a p} {c
6e20: 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a lose $s; error}.
6e30: 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a set c [tls::
6e40: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
6e50: 20 32 38 39 38 5d 0a 20 20 20 20 76 77 61 69 74 2898]. vwait
6e60: 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 6c goterror. cl
6e70: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
6e80: 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 65 $c. set gote
6e90: 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 73 rror.} 1..test s
6ea0: 6f 63 6b 65 74 2d 31 31 2e 31 20 7b 74 63 70 20 ocket-11.1 {tcp
6eb0: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
6ec0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
6ed0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
6ee0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
6ef0: 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 31 5f ..set socket9_1_
6f00: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
6f10: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
6f20: 20 61 63 63 65 70 74 20 32 38 33 34 5d 0a 09 70 accept 2834]..p
6f30: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
6f40: 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 p} {.. puts $
6f50: 73 20 64 6f 6e 65 0a 09 20 20 20 20 63 6c 6f 73 s done.. clos
6f60: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
6f70: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
6f80: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
6f90: 65 72 49 50 20 32 38 33 34 5d 0a 20 20 20 20 73 erIP 2834]. s
6fa0: 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 et r [gets $s].
6fb0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
6fc0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
6fd0: 73 65 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 65 se $socket9_1_te
6fe0: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
6ff0: 65 74 20 72 0a 7d 20 64 6f 6e 65 0a 74 65 73 74 et r.} done.test
7000: 20 73 6f 63 6b 65 74 2d 31 31 2e 32 20 7b 63 6c socket-11.2 {cl
7010: 69 65 6e 74 20 73 70 65 63 69 66 69 65 73 20 69 ient specifies i
7020: 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 ts port} {socket
7030: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
7040: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
7050: 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 if {[info exists
7060: 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 port]} {..incr
7070: 70 6f 72 74 0a 20 20 20 20 7d 20 65 6c 73 65 20 port. } else
7080: 7b 0a 09 73 65 74 20 70 6f 72 74 20 5b 65 78 70 {..set port [exp
7090: 72 20 32 30 34 38 20 2b 20 5b 70 69 64 5d 25 31 r 2048 + [pid]%1
70a0: 30 32 34 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 024]. }. s
70b0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
70c0: 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 t socket9_2_test
70d0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
70e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
70f0: 65 70 74 20 32 38 33 35 5d 0a 09 70 72 6f 63 20 ept 2835]..proc
7100: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
7110: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 24 70 .. puts $s $p
7120: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
7130: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
7140: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
7150: 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 24 72 65 myport $port $re
7160: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 moteServerIP 283
7170: 35 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 5]. set r [ge
7180: 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $s]. close
7190: 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s. sendComm
71a0: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
71b0: 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 et9_2_test_serve
71c0: 72 7d 0a 20 20 20 20 69 66 20 7b 24 72 20 3d 3d r}. if {$r ==
71d0: 20 24 70 6f 72 74 7d 20 7b 0a 09 73 65 74 20 72 $port} {..set r
71e0: 65 73 75 6c 74 20 6f 6b 0a 20 20 20 20 7d 20 65 esult ok. } e
71f0: 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c lse {..set resul
7200: 74 20 62 72 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 t broken. }.
7210: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 set result.}
7220: 6f 6b 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 ok.test socket-1
7230: 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 6f 20 63 1.3 {trying to c
7240: 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 72 76 65 onnect, no serve
7250: 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 r} {socket doTes
7260: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
7270: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 er} {. set st
7280: 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b atus ok. if {
7290: 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 20 5b ![catch {set s [
72a0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d tls::socket $rem
72b0: 6f 74 65 53 65 72 76 65 72 49 70 20 32 38 33 36 oteServerIp 2836
72c0: 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 ]}]} {..if {![ca
72d0: 74 63 68 20 7b 67 65 74 73 20 24 73 7d 5d 7d 20 tch {gets $s}]}
72e0: 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 75 {.. set statu
72f0: 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f s broken..}..clo
7300: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
7310: 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a set status.} ok.
7320: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 34 test socket-11.4
7330: 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 6f {remote echo, o
7340: 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 ne line} {socket
7350: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
7360: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
7370: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
7380: 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 et socket10_6_te
7390: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
73a0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
73b0: 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f ccept 2836]..pro
73c0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
73d0: 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e {.. fileeven
73e0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
73f0: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 ist echo $s]..
7400: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
7410: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
7420: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
7430: 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 f..}..proc echo
7440: 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c {s} {.. set l
7450: 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 [gets $s]..
7460: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
7470: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
7480: 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 } else {...puts
7490: 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a $s $l.. }..}.
74a0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 }. set f
74b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
74c0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 moteServerIP 283
74d0: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
74e0: 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $f -translatio
74f0: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
7500: 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 20 g line. puts
7510: 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 74 $f hello. set
7520: 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 r [gets $f].
7530: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
7540: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
7550: 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 $socket10_6_tes
7560: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
7570: 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 74 65 73 74 t r.} hello.test
7580: 20 73 6f 63 6b 65 74 2d 31 31 2e 35 20 7b 72 65 socket-11.5 {re
7590: 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 mote echo, 50 li
75a0: 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 nes} {socket doT
75b0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
75c0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
75d0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
75e0: 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 ocket10_7_test_s
75f0: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
7600: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
7610: 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 2836]..proc ac
7620: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
7630: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
7640: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
7650: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
7660: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
7670: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
7680: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d nslation crlf..}
7690: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
76a0: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
76b0: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b ts $s].. if {
76c0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
76d0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
76e0: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 se {...puts $s $
76f0: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 l.. }..}.
7700: 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 }. set f [tls
7710: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
7720: 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 ServerIP 2836].
7730: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
7740: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 -translation cr
7750: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
7760: 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 ne. for {set
7770: 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 cnt 0} {$cnt < 5
7780: 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 0} {incr cnt} {.
7790: 09 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c .puts $f "hello,
77a0: 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 74 72 $cnt"..if {[str
77b0: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 65 74 ing compare [get
77c0: 73 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 s $f] "hello, $c
77d0: 6e 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 20 20 nt"] != 0} {..
77e0: 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d break..}. }
77f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
7800: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
7810: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 lose $socket10_7
7820: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
7830: 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 23 set cnt.} 50.#
7840: 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 Macintosh socke
7850: 74 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 ts can have more
7860: 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 than one server
7870: 20 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 per port.if {$t
7880: 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 cl_platform(plat
7890: 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 6e 74 form) == "macint
78a0: 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 osh"} {. set
78b0: 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b conflictResult {
78c0: 30 20 32 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0 2836}.} else {
78d0: 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 . set conflic
78e0: 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c tResult {1 {coul
78f0: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
7900: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
7910: 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 74 65 73 y in use}}.}.tes
7920: 74 20 73 6f 63 6b 65 74 2d 31 31 2e 36 20 7b 73 t socket-11.6 {s
7930: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
7940: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
7950: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
7960: 20 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 {. set s1 [t
7970: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
7980: 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a er accept 2836].
7990: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
79a0: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
79b0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
79c0: 70 74 20 32 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 pt 2836]} msg]}
79d0: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c {..set result [l
79e0: 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 ist 1 $msg].
79f0: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 } else {..set re
7a00: 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 sult [list 0 [li
7a10: 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 ndex [fconfigure
7a20: 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 $s2 -sockname]
7a30: 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 2]]..close $s2.
7a40: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
7a50: 73 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c s1. set resul
7a60: 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 t.} $conflictRes
7a70: 75 6c 74 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d ult.test socket-
7a80: 31 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 11.7 {server wit
7a90: 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 h several client
7aa0: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
7ab0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
7ac0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
7ad0: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
7ae0: 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 ket10_9_test_ser
7af0: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
7b00: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
7b10: 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 2836]..proc acce
7b20: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
7b30: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
7b40: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
7b50: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
7b60: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
7b70: 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 echo $s]..}..pr
7b80: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
7b90: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
7ba0: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
7bb0: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
7bc0: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
7bd0: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
7be0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
7bf0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
7c00: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
7c10: 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 verIP 2836].
7c20: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d fconfigure $s1 -
7c30: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
7c40: 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a set s2 [tls::
7c50: 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 socket $remoteSe
7c60: 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 rverIP 2836].
7c70: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 fconfigure $s2
7c80: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
7c90: 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a set s3 [tls:
7ca0: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
7cb0: 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 erverIP 2836].
7cc0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 fconfigure $s3
7cd0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
7ce0: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
7cf0: 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 0} {$i < 100} {i
7d00: 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 ncr i} {..puts $
7d10: 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 s1 hello,s1..get
7d20: 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 s $s1..puts $s2
7d30: 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 hello,s2..gets $
7d40: 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c s2..puts $s3 hel
7d50: 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a lo,s3..gets $s3.
7d60: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
7d70: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
7d80: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
7d90: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
7da0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
7db0: 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _9_test_server}.
7dc0: 20 20 20 20 73 65 74 20 69 0a 7d 20 31 30 30 20 set i.} 100
7dd0: 20 20 20 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d .test socket-
7de0: 31 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 11.8 {client wit
7df0: 68 20 73 65 76 65 72 61 6c 20 73 65 72 76 65 72 h several server
7e00: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
7e10: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
7e20: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
7e30: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 31 20 mmand {..set s1
7e40: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
7e50: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
7e60: 33 22 20 34 30 30 33 5d 0a 09 73 65 74 20 73 32 3" 4003]..set s2
7e70: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
7e80: 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 erver "accept 40
7e90: 30 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 73 04" 4004]..set s
7ea0: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 3 [tls::socket -
7eb0: 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 server "accept 4
7ec0: 30 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 005" 4005]..proc
7ed0: 20 61 63 63 65 70 74 20 7b 6d 70 20 73 20 61 20 accept {mp s a
7ee0: 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 p} {.. puts $
7ef0: 73 20 24 6d 70 0a 09 20 20 20 20 63 6c 6f 73 65 s $mp.. close
7f00: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
7f10: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
7f20: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
7f30: 65 72 49 50 20 34 30 30 33 5d 0a 20 20 20 20 73 erIP 4003]. s
7f40: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
7f50: 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 et $remoteServer
7f60: 49 50 20 34 30 30 34 5d 0a 20 20 20 20 73 65 74 IP 4004]. set
7f70: 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s3 [tls::socket
7f80: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
7f90: 20 34 30 30 35 5d 0a 20 20 20 20 73 65 74 20 6c 4005]. set l
7fa0: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
7fb0: 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 67 65 l [gets $s1] [ge
7fc0: 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 24 73 31 ts $s1] [eof $s1
7fd0: 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 67 65 ] [gets $s2] [ge
7fe0: 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 24 73 32 ts $s2] [eof $s2
7ff0: 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 33 5d 20 ] \..[gets $s3]
8000: 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 6f 66 20 [gets $s3] [eof
8010: 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s3]. close $
8020: 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 s1. close $s2
8030: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 . close $s3.
8040: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
8050: 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 63 6c 6f ..close $s1..clo
8060: 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 20 24 73 se $s2..close $s
8070: 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 3. }. set
8080: 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 31 20 34 l.} {4003 {} 1 4
8090: 30 30 34 20 7b 7d 20 31 20 34 30 30 35 20 7b 7d 004 {} 1 4005 {}
80a0: 20 31 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 1}.test socket-
80b0: 31 31 2e 39 20 7b 61 63 63 65 70 74 20 63 61 6c 11.9 {accept cal
80c0: 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f lback error} {so
80d0: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
80e0: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
80f0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
8100: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
8110: 63 63 65 70 74 20 32 38 33 36 5d 0a 20 20 20 20 ccept 2836].
8120: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
8130: 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 p} {expr 10 / 0
8140: 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 }. proc bgerr
8150: 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 or args {..globa
8160: 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 l x..set x $args
8170: 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 5b . }. if {[
8180: 63 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 catch {sendComma
8190: 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 nd {.. set pe
81a0: 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 ername [fconfigu
81b0: 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 re $callerSocket
81c0: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 -peername]..
81d0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
81e0: 6b 65 74 20 5b 6c 69 6e 64 65 78 20 24 70 65 65 ket [lindex $pee
81f0: 72 6e 61 6d 65 20 30 5d 20 32 38 33 36 5d 0a 09 rname 0] 2836]..
8200: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
8210: 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 . }} msg]} {..c
8220: 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 24 lose $s..error $
8230: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 msg. }. se
8240: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
8250: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
8260: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
8270: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
8280: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
8290: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e close $s. ren
82a0: 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 ame bgerror {}.
82b0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 set x.} {{div
82c0: 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 74 65 ide by zero}}.te
82d0: 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 30 20 st socket-11.10
82e0: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
82f0: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
8300: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
8310: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
8320: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d r} {. sendCom
8330: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
8340: 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 et10_12_test_ser
8350: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
8360: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
8370: 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 2836]..proc acce
8380: 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 pt {s a p} {clos
8390: 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 e $s}. }.
83a0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
83b0: 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 et $remoteServer
83c0: 49 50 20 32 38 33 36 5d 0a 20 20 20 20 73 65 74 IP 2836]. set
83d0: 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 p [fconfigure $
83e0: 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 s -peername].
83f0: 20 73 65 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 set n [fconfigu
8400: 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d re $s -sockname]
8410: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
8420: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
8430: 64 65 78 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 dex $p 2] [lleng
8440: 74 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 th $p] [llength
8450: 24 70 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $p]. close $s
8460: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8470: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
8480: 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 0_12_test_server
8490: 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 32 }. set l.} {2
84a0: 38 33 36 20 33 20 33 7d 0a 74 65 73 74 20 73 6f 836 3 3}.test so
84b0: 63 6b 65 74 2d 31 31 2e 31 31 20 7b 74 65 73 74 cket-11.11 {test
84c0: 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 ing spurious eve
84d0: 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 nts} {socket doT
84e0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
84f0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
8500: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
8510: 6f 63 6b 65 74 31 30 5f 31 33 5f 74 65 73 74 5f ocket10_13_test_
8520: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
8530: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
8540: 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 pt 2836]..proc a
8550: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
8560: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
8570: 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $s -translation
8580: 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 20 20 61 "auto lf".. a
8590: 66 74 65 72 20 31 30 30 20 77 72 69 74 65 73 6f fter 100 writeso
85a0: 6d 65 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 me $s..}..proc w
85b0: 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 ritesome {s} {..
85c0: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
85d0: 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e } {$i < 100} {in
85e0: 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 cr i} {...puts $
85f0: 73 20 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 s "line $i from
8600: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 remote server"..
8610: 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 }.. close
8620: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
8630: 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 set len 0. s
8640: 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 et spurious 0.
8650: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
8660: 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 proc readlittle
8670: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 {s} {..global s
8680: 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e purious done len
8690: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
86a0: 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 1]..if {[string
86b0: 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 length $l] == 0
86c0: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 } {.. if {![e
86d0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 of $s]} {...incr
86e0: 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d spurious.. }
86f0: 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 else {...close
8700: 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a $s...set done 1.
8710: 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b . }..} else {
8720: 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b .. incr len [
8730: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
8740: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 ]..}. }. s
8750: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
8760: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
8770: 50 20 32 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 P 2836]. file
8780: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
8790: 65 20 22 72 65 61 64 6c 69 74 74 6c 65 20 24 63 e "readlittle $c
87a0: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
87b0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
87c0: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
87d0: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e "]. vwait don
87e0: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
87f0: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 el $timer. se
8800: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
8810: 20 24 73 6f 63 6b 65 74 31 30 5f 31 33 5f 74 65 $socket10_13_te
8820: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 6c st_server}. l
8830: 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c ist $spurious $l
8840: 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a 74 65 en.} {0 2690}.te
8850: 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 32 20 st socket-11.12
8860: 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 {testing EOF sti
8870: 63 6b 79 6e 65 73 73 7d 20 7b 73 6f 63 6b 65 74 ckyness} {socket
8880: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
8890: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
88a0: 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 set counter 0.
88b0: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
88c0: 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 20 7b proc count_up {
88d0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
88e0: 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 65 72 5f nter done after_
88f0: 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 id..set l [gets
8900: 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 $s]..if {[eof $s
8910: 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 ]} {.. incr c
8920: 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 66 20 7b ounter.. if {
8930: 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 7b 0a $counter > 9} {.
8940: 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f 46 20 ..set done {EOF
8950: 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 is sticky}...aft
8960: 65 72 20 63 61 6e 63 65 6c 20 24 61 66 74 65 72 er cancel $after
8970: 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 _id...close $s..
8980: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
8990: 20 20 20 70 72 6f 63 20 74 69 6d 65 64 5f 6f 75 proc timed_ou
89a0: 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 t {} {..global c
89b0: 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e 65 20 done..set done
89c0: 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f 46 20 {timed_out, EOF
89d0: 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 is not sticky}..
89e0: 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 close $c. }.
89f0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
8a00: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 ..set socket10_1
8a10: 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 4_test_server [t
8a20: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
8a30: 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a er accept 2836].
8a40: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
8a50: 61 20 70 7d 20 7b 0a 09 20 20 20 20 61 66 74 65 a p} {.. afte
8a60: 72 20 31 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 r 100 close $s..
8a70: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
8a80: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 c [tls::socket $
8a90: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
8aa0: 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 76 65 836]. fileeve
8ab0: 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 nt $c readable "
8ac0: 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a 20 20 20 count_up $c".
8ad0: 20 73 65 74 20 61 66 74 65 72 5f 69 64 20 5b 61 set after_id [a
8ae0: 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 64 5f fter 1000 timed_
8af0: 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 20 64 out]. vwait d
8b00: 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d one. sendComm
8b10: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
8b20: 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 et10_14_test_ser
8b30: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 64 6f 6e ver}. set don
8b40: 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 74 69 63 e.} {EOF is stic
8b50: 6b 79 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d ky}.test socket-
8b60: 31 31 2e 31 33 20 7b 74 65 73 74 69 6e 67 20 61 11.13 {testing a
8b70: 73 79 6e 63 20 77 72 69 74 65 2c 20 61 73 79 6e sync write, asyn
8b80: 63 20 66 6c 75 73 68 2c 20 61 73 79 6e 63 20 63 c flush, async c
8b90: 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 lose} \..{socket
8ba0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
8bb0: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
8bc0: 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 proc readit {s}
8bd0: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 {..global count
8be0: 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 61 done..set l [rea
8bf0: 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 6e d $s]..incr coun
8c00: 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 t [string length
8c10: 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 $l]..if {[eof $
8c20: 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 s]} {.. close
8c30: 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f 6e $s.. set don
8c40: 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 e 1..}. }.
8c50: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
8c60: 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 set firstblock "
8c70: 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d "..for {set i 0}
8c80: 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 20 {$i < 5} {incr
8c90: 69 7d 20 7b 0a 09 09 73 65 74 20 66 69 72 73 74 i} {...set first
8ca0: 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 62 6c block "a$firstbl
8cb0: 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 0a ock$firstblock".
8cc0: 09 7d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c .}..set secondbl
8cd0: 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 74 ock ""..for {set
8ce0: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d 20 i 0} {$i < 16}
8cf0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 {incr i} {..
8d00: 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 set secondblock
8d10: 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 "b$secondblock$s
8d20: 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 09 7d 0a 09 econdblock"..}..
8d30: 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b set l [tls::sock
8d40: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
8d50: 74 20 32 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 t 2845]..proc ac
8d60: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
8d70: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
8d80: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 s -blocking 0 -t
8d90: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 ranslation lf -b
8da0: 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 34 20 uffersize 16384
8db0: 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c \...-buffering l
8dc0: 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 ine.. fileeve
8dd0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
8de0: 72 65 61 64 61 62 6c 65 20 24 73 22 0a 09 7d 0a readable $s"..}.
8df0: 09 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 7b .proc readable {
8e00: 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 s} {.. set l
8e10: 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 66 [gets $s].. f
8e20: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
8e30: 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 66 74 able {}.. aft
8e40: 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 er 1000 respond
8e50: 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 73 70 $s..}..proc resp
8e60: 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 ond {s} {.. g
8e70: 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b lobal firstblock
8e80: 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 .. puts -none
8e90: 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 wline $s $firstb
8ea0: 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 72 20 lock.. after
8eb0: 31 30 30 30 20 77 72 69 74 65 64 61 74 61 20 24 1000 writedata $
8ec0: 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 s..}..proc write
8ed0: 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 20 20 data {s} {..
8ee0: 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f global secondblo
8ef0: 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f ck.. puts -no
8f00: 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f newline $s $seco
8f10: 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 6c 6f ndblock.. clo
8f20: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
8f30: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8f40: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
8f50: 76 65 72 49 50 20 32 38 34 35 5d 0a 20 20 20 20 verIP 2845].
8f60: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
8f70: 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 locking 0 -trans
8f80: 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c lf -buffering l
8f90: 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e ine. set coun
8fa0: 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 t 0. puts $s
8fb0: 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 hello. fileev
8fc0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
8fd0: 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 "readit $s".
8fe0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
8ff0: 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 10000 "set done
9000: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
9010: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
9020: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
9030: 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d mer. sendComm
9040: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 and {close $l}.
9050: 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 set count.} 6
9060: 35 35 36 36 0a 0a 74 65 73 74 20 73 6f 63 6b 65 5566..test socke
9070: 74 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 t-12.1 {testing
9080: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 73 inheritance of s
9090: 65 72 76 65 72 20 73 6f 63 6b 65 74 73 7d 20 5c erver sockets} \
90a0: 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 ..{socket doTest
90b0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
90c0: 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 r} {. removeF
90d0: 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 ile script1.
90e0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
90f0: 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 t2.. # Script
9100: 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 1 is just a 10 s
9110: 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 econd delay. If
9120: 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b the server sock
9130: 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 et. # is inhe
9140: 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 rited, it will b
9150: 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 e held open for
9160: 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 10 seconds..
9170: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
9180: 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt1 w]. puts
9190: 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 $f {..after 1000
91a0: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
91b0: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
91c0: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
91d0: 53 63 72 69 70 74 32 20 63 72 65 61 74 65 73 20 Script2 creates
91e0: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
91f0: 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 t, launches scri
9200: 70 74 31 2c 0a 20 20 20 20 23 20 77 61 69 74 73 pt1,. # waits
9210: 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 a second, and e
9220: 78 69 74 73 2e 20 20 54 68 65 20 73 65 72 76 65 xits. The serve
9230: 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f r socket will no
9240: 77 0a 20 20 20 20 23 20 62 65 20 63 6c 6f 73 65 w. # be close
9250: 64 20 75 6e 6c 65 73 73 20 73 63 72 69 70 74 31 d unless script1
9260: 20 69 6e 68 65 72 69 74 65 64 20 69 74 2e 0a 0a inherited it...
9270: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
9280: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 script2 w]. p
9290: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
92a0: 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 63 6c 74 tcltest $::tclt
92b0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 est::tcltest].
92c0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
92d0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 63 6c kage require tcl
92e0: 74 65 73 74 0a 09 73 65 74 20 66 20 5b 74 6c 73 test..set f [tls
92f0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
9300: 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 70 accept 2828]..p
9310: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
9320: 65 20 61 64 64 72 20 70 6f 72 74 20 7d 20 7b 0a e addr port } {.
9330: 09 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 . close $file
9340: 0a 09 7d 0a 09 65 78 65 63 20 24 3a 3a 74 63 6c ..}..exec $::tcl
9350: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
9360: 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 ript1 &..close $
9370: 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 78 f..after 1000 ex
9380: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
9390: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
93a0: 65 20 24 66 0a 09 0a 20 20 20 20 23 20 4c 61 75 e $f... # Lau
93b0: 6e 63 68 20 73 63 72 69 70 74 32 20 61 6e 64 20 nch script2 and
93c0: 77 61 69 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a wait 5 seconds..
93d0: 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 exec $::tclt
93e0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
93f0: 69 70 74 32 20 26 0a 20 20 20 20 61 66 74 65 72 ipt2 &. after
9400: 20 35 30 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 5000 { set ok_t
9410: 6f 5f 70 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 o_proceed 1 }.
9420: 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 vwait ok_to_pr
9430: 6f 63 65 65 64 0a 0a 20 20 20 20 23 20 49 66 20 oceed.. # If
9440: 77 65 20 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e we can still con
9450: 6e 65 63 74 20 74 6f 20 74 68 65 20 73 65 72 76 nect to the serv
9460: 65 72 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 67 er, the socket g
9470: 6f 74 20 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 ot inherited...
9480: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
9490: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
94a0: 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 5d 7d .0.1 2828} msg]}
94b0: 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 {..set x {serve
94c0: 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 r socket was not
94d0: 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 inherited}.
94e0: 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 } else {..close
94f0: 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 65 72 $msg..set x {ser
9500: 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 69 ver socket was i
9510: 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 0a nherited}. }.
9520: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
9530: 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f script1. remo
9540: 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 veFile script2.
9550: 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 72 76 set x.} {serv
9560: 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f er socket was no
9570: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 74 65 73 t inherited}.tes
9580: 74 20 73 6f 63 6b 65 74 2d 31 32 2e 32 20 7b 74 t socket-12.2 {t
9590: 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e esting inheritan
95a0: 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 6f 63 ce of client soc
95b0: 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 kets} \..{socket
95c0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
95d0: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
95e0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
95f0: 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c t1. removeFil
9600: 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 e script2.. #
9610: 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 Script1 is just
9620: 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c a 10 second del
9630: 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 ay. If the serv
9640: 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 er socket. #
9650: 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 is inherited, it
9660: 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 will be held op
9670: 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 en for 10 second
9680: 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 s.. set f [op
9690: 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 en script1 w].
96a0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 puts $f {..aft
96b0: 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 er 10000 exit..v
96c0: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
96d0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
96e0: 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 6f . # Script2 o
96f0: 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 20 pens the client
9700: 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 65 socket and write
9710: 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 65 s to it. It the
9720: 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 73 n. # launches
9730: 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 69 script1 and exi
9740: 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 6c ts. If the chil
9750: 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 69 d process inheri
9760: 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 6c ted the. # cl
9770: 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 65 ient socket, the
9780: 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 69 socket will sti
9790: 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 ll be open...
97a0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
97b0: 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt2 w]. puts
97c0: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
97d0: 6c 74 65 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 ltest $::tcltest
97e0: 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 ::tcltest]. p
97f0: 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 66 20 uts $f {..set f
9800: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
9810: 2e 30 2e 30 2e 31 20 32 38 32 39 5d 0a 09 65 78 .0.0.1 2829]..ex
9820: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
9830: 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 20 26 cltest script1 &
9840: 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 69 6e ..puts $f testin
9850: 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 66 74 g..flush $f..aft
9860: 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 er 1000 exit..vw
9870: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
9880: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
9890: 20 20 20 20 23 20 43 72 65 61 74 65 20 74 68 65 # Create the
98a0: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 0a server socket..
98b0: 20 20 20 20 73 65 74 20 73 65 72 76 65 72 20 5b set server [
98c0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
98d0: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 39 5d ver accept 2829]
98e0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
98f0: 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 { file host por
9900: 74 20 7d 20 7b 0a 0a 09 23 20 57 68 65 6e 20 74 t } {...# When t
9910: 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 he client connec
9920: 74 73 2c 20 65 73 74 61 62 6c 69 73 68 20 74 68 ts, establish th
9930: 65 20 72 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 e read handler..
9940: 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a 09 63 global server..c
9950: 6c 6f 73 65 20 24 73 65 72 76 65 72 0a 09 66 69 lose $server..fi
9960: 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 20 72 65 leevent $file re
9970: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 adable [list get
9980: 64 61 74 61 20 24 66 69 6c 65 5d 0a 09 66 63 6f data $file]..fco
9990: 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 2d 62 nfigure $file -b
99a0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 62 uffering line -b
99b0: 6c 6f 63 6b 69 6e 67 20 30 0a 09 72 65 74 75 72 locking 0..retur
99c0: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 n. }. proc
99d0: 20 67 65 74 64 61 74 61 20 7b 20 66 69 6c 65 20 getdata { file
99e0: 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 61 6e } {...# Read han
99f0: 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 63 65 dler on the acce
9a00: 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 09 67 6c pted socket...gl
9a10: 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 obal x..global f
9a20: 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 74 75 ailed..set statu
9a30: 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 s [catch {read $
9a40: 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 file} data]..if
9a50: 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d 20 7b {$status != 0} {
9a60: 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 65 61 .. set x {rea
9a70: 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 d failed, error
9a80: 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 20 20 was $data}..
9a90: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
9aa0: 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 ile }..} elseif
9ab0: 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 {[string compare
9ac0: 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d {} $data]} {..}
9ad0: 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b elseif {[fblock
9ae0: 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 ed $file]} {..}
9af0: 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 elseif {[eof $fi
9b00: 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b le]} {.. if {
9b10: 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 $failed} {...set
9b20: 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 x {client socke
9b30: 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d t was inherited}
9b40: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
9b50: 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 .set x {client s
9b60: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
9b70: 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a herited}.. }.
9b80: 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f . catch { clo
9b90: 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c se $file }..} el
9ba0: 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 se {.. set x
9bb0: 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 {impossible case
9bc0: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
9bd0: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a lose $file }..}.
9be0: 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 .return. }..
9bf0: 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b # If the sock
9c00: 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 20 65 et doesn't hit e
9c10: 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 nd-of-file in 5
9c20: 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 seconds, the.
9c30: 20 23 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 # script1 proce
9c40: 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 ss must have inh
9c50: 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 65 6e erited the clien
9c60: 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c t... set fail
9c70: 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 ed 0. after 5
9c80: 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 66 61 000 [list set fa
9c90: 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c iled 1].. # L
9ca0: 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 74 aunch the script
9cb0: 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 2 process.. e
9cc0: 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a xec $::tcltest::
9cd0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 tcltest script2
9ce0: 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 &.. vwait x.
9cf0: 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 7d if {!$failed}
9d00: 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 64 {..vwait failed
9d10: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 6d 6f 76 . }. remov
9d20: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
9d30: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
9d40: 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a 7d ipt2. set x.}
9d50: 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 {client socket
9d60: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
9d70: 64 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 d}.test socket-1
9d80: 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 2.3 {testing inh
9d90: 65 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 65 eritance of acce
9da0: 70 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c 0a pted sockets} \.
9db0: 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 .{socket doTests
9dc0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
9dd0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
9de0: 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 le script1. r
9df0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
9e00: 32 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 2.. set f [op
9e10: 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 en script1 w].
9e20: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 puts $f {..aft
9e30: 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 er 10000 exit..v
9e40: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
9e50: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
9e60: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
9e70: 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 script2 w].
9e80: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
9e90: 74 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 63 6c t tcltest $::tcl
9ea0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 test::tcltest].
9eb0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 puts $f {..se
9ec0: 74 20 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t server [tls::s
9ed0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
9ee0: 63 65 70 74 20 32 39 33 30 5d 0a 09 70 72 6f 63 cept 2930]..proc
9ef0: 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 accept { file h
9f00: 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 ost port } {..
9f10: 20 20 67 6c 6f 62 61 6c 20 74 63 6c 74 65 73 74 global tcltest
9f20: 0a 09 20 20 20 20 70 75 74 73 20 24 66 69 6c 65 .. puts $file
9f30: 20 7b 74 65 73 74 20 64 61 74 61 20 6f 6e 20 73 {test data on s
9f40: 6f 63 6b 65 74 7d 0a 09 20 20 20 20 65 78 65 63 ocket}.. exec
9f50: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
9f60: 74 65 73 74 20 73 63 72 69 70 74 31 20 26 0a 09 test script1 &..
9f70: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 65 after 1000 e
9f80: 78 69 74 0a 09 7d 0a 09 76 77 61 69 74 20 66 6f xit..}..vwait fo
9f90: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
9fa0: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
9fb0: 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 70 Launch the scrip
9fc0: 74 32 20 70 72 6f 63 65 73 73 20 61 6e 64 20 63 t2 process and c
9fd0: 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 20 53 onnect to it. S
9fe0: 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 ee how long.
9ff0: 23 20 74 68 65 20 73 6f 63 6b 65 74 20 73 74 61 # the socket sta
a000: 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 78 65 ys open.. exe
a010: 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 c $::tcltest::tc
a020: 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a ltest script2 &.
a030: 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
a040: 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 set ok_to_procee
a050: 64 20 31 0a 20 20 20 20 76 77 61 69 74 20 6f 6b d 1. vwait ok
a060: 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 _to_proceed..
a070: 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 set f [tls::soc
a080: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 39 ket 127.0.0.1 29
a090: 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 30]. fconfigu
a0a0: 72 65 20 24 66 20 2d 62 75 66 66 65 72 69 6e 67 re $f -buffering
a0b0: 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 full -blocking
a0c0: 30 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 0. fileevent
a0d0: 24 66 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $f readable [lis
a0e0: 74 20 67 65 74 64 61 74 61 20 24 66 5d 0a 0a 20 t getdata $f]..
a0f0: 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b # If the sock
a100: 65 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e et is still open
a110: 20 61 66 74 65 72 20 35 20 73 65 63 6f 6e 64 73 after 5 seconds
a120: 2c 20 74 68 65 20 73 63 72 69 70 74 31 20 70 72 , the script1 pr
a130: 6f 63 65 73 73 0a 20 20 20 20 23 20 6d 75 73 74 ocess. # must
a140: 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 have inherited
a150: 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 the accepted soc
a160: 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ket... set fa
a170: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
a180: 20 35 30 30 30 20 73 65 74 20 66 61 69 6c 65 64 5000 set failed
a190: 20 31 0a 0a 20 20 20 20 70 72 6f 63 20 67 65 74 1.. proc get
a1a0: 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a data { file } {.
a1b0: 0a 09 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 ..# Read handler
a1c0: 20 6f 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 73 on the client s
a1d0: 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 ocket...global x
a1e0: 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a ..global failed.
a1f0: 09 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 .set status [cat
a200: 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 ch {read $file}
a210: 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 data]..if {$stat
a220: 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 us != 0} {..
a230: 73 65 74 20 78 20 7b 72 65 61 64 20 66 61 69 6c set x {read fail
a240: 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 ed, error was $d
a250: 61 74 61 7d 0a 09 20 20 20 20 63 61 74 63 68 20 ata}.. catch
a260: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
a270: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 .} elseif {[stri
a280: 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 ng compare {} $d
a290: 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 ata]} {..} elsei
a2a0: 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 f {[fblocked $fi
a2b0: 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 le]} {..} elseif
a2c0: 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b {[eof $file]} {
a2d0: 0a 09 20 20 20 20 69 66 20 7b 24 66 61 69 6c 65 .. if {$faile
a2e0: 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 d} {...set x {ac
a2f0: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 cepted socket wa
a300: 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 s inherited}..
a310: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 } else {...set
a320: 20 78 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 x {accepted soc
a330: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
a340: 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 rited}.. }..
a350: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
a360: 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 $file }..} else
a370: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 {.. set x {i
a380: 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a mpossible case}.
a390: 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f . catch { clo
a3a0: 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 se $file }..}..r
a3b0: 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 eturn. }.
a3c0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 0a 20 20 . vwait x..
a3d0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
a3e0: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
a3f0: 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 20 ile script2.
a400: 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 set x.} {accepte
a410: 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 d socket was not
a420: 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 inherited}..tes
a430: 74 20 73 6f 63 6b 65 74 2d 31 33 2e 31 20 7b 54 t socket-13.1 {T
a440: 65 73 74 69 6e 67 20 75 73 65 20 6f 66 20 73 68 esting use of sh
a450: 61 72 65 64 20 73 6f 63 6b 65 74 20 62 65 74 77 ared socket betw
a460: 65 65 6e 20 74 77 6f 20 74 68 72 65 61 64 73 7d een two threads}
a470: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 \..{socket test
a480: 74 68 72 65 61 64 7d 20 7b 0a 0a 20 20 20 20 72 thread} {.. r
a490: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
a4a0: 0a 20 20 20 20 74 68 72 65 61 64 52 65 61 70 0a . threadReap.
a4b0: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a . makeFile {.
a4c0: 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 .set f [tls::soc
a4d0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
a4e0: 70 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 pt 2828]..proc a
a4f0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
a500: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 file
a510: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
a520: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
a530: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f . fco
a540: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
a550: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
a560: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
a570: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
a580: 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 al i.
a590: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
a5a0: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
a5b0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
a5c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5d0: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
a5e0: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
a5f0: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
a600: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
a610: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
a620: 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 se { ..
a630: 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 incr i.
a640: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
a650: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
a660: 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 }..}..set i 0..v
a670: 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 wait x..close $f
a680: 0a 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 61 ...# thread clea
a690: 6e 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 ns itself up...t
a6a0: 65 73 74 74 68 72 65 61 64 20 65 78 69 74 0a 20 estthread exit.
a6b0: 20 20 20 7d 20 73 63 72 69 70 74 0a 20 20 20 20 } script.
a6c0: 0a 20 20 20 20 23 20 63 72 65 61 74 65 20 61 20 . # create a
a6d0: 74 68 72 65 61 64 0a 20 20 20 20 73 65 74 20 73 thread. set s
a6e0: 65 72 76 65 72 74 68 72 65 61 64 20 5b 74 65 73 erverthread [tes
a6f0: 74 74 68 72 65 61 64 20 63 72 65 61 74 65 20 7b tthread create {
a700: 20 73 6f 75 72 63 65 20 73 63 72 69 70 74 20 7d source script }
a710: 20 5d 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 ]. update.
a720: 20 20 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 . after 100
a730: 30 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 0. set s [tls
a740: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
a750: 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 2828]. fco
a760: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
a770: 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 ering line..
a780: 63 61 74 63 68 20 7b 0a 09 70 75 74 73 20 24 73 catch {..puts $s
a790: 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 "hello"..gets $
a7a0: 73 20 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 s result. }.
a7b0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
a7c0: 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 update.. afte
a7d0: 72 20 32 30 30 30 0a 20 20 20 20 6c 61 70 70 65 r 2000. lappe
a7e0: 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 72 65 61 nd result [threa
a7f0: 64 52 65 61 70 5d 0a 20 20 20 20 0a 20 20 20 20 dReap]. .
a800: 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 set result..} {h
a810: 65 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c 65 61 6e ello 1}..# clean
a820: 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d up.if {[string m
a830: 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d atch sock* $comm
a840: 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d andSocket] == 1}
a850: 20 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 6d 6d {. puts $comm
a860: 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 0a 20 andSocket exit.
a870: 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 6e 64 flush $command
a880: 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 20 7b Socket.}.catch {
a890: 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f close $commandSo
a8a0: 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 6c 6f cket}.catch {clo
a8b0: 73 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 43 68 se $remoteProcCh
a8c0: 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 an}.::tcltest::c
a8d0: 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 6c 75 73 leanupTests.flus
a8e0: 68 20 73 74 64 6f 75 74 0a 72 65 74 75 72 6e 0a h stdout.return.
a8f0: 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a ...........