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 32 20 32 30 30 30 2f test,v 1.2 2000/
0210: 30 36 2f 30 32 20 31 39 3a 31 37 3a 31 31 20 61 06/02 19:17:11 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 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 io pcCrash} {.
3720: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 makeFile {.
3730: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
3740: 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c e tls..set f [tl
3750: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
3760: 72 20 61 63 63 65 70 74 20 32 38 33 35 5d 0a 09 r accept 2835]..
3770: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
3780: 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 p} {.
3790: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
37a0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
37b0: 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ho $s].
37c0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
37d0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
37e0: 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 . }..proc
37f0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
3800: 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 global i.
3810: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
3820: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
3830: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
3840: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
3850: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
3860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3870: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
3880: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
3890: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
38a0: 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 } else { ..
38b0: 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 incr i.
38c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
38d0: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
38e0: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 }..}..set
38f0: 69 20 30 0a 09 70 75 74 73 20 72 65 61 64 79 0a i 0..puts ready.
3900: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
3910: 72 20 32 30 30 30 30 20 22 73 65 74 20 78 20 64 r 20000 "set x d
3920: 6f 6e 65 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 one"]..vwait x..
3930: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
3940: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 mer..close $f..p
3950: 75 74 73 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 uts "done $i".
3960: 20 20 7d 20 73 63 72 69 70 74 0a 20 20 20 20 73 } script. s
3970: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
3980: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
3990: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
39a0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
39b0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
39c0: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
39d0: 32 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2835]. fconfi
39e0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
39f0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 ng line. catc
3a00: 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 h {..for {set x
3a10: 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 0} {$x < 50} {in
3a20: 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 cr x} {.. put
3a30: 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 s $s "hello abcd
3a40: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 efghijklmnop"..
3a50: 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 gets $s..}.
3a60: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
3a70: 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 . catch {set
3a80: 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 x [gets $f]}.
3a90: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
3aa0: 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a t x.} {done 50}.
3ab0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 39 .test socket-2.9
3ac0: 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 {socket conflic
3ad0: 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f t} {socket stdio
3ae0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
3af0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
3b00: 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a er accept 2828].
3b10: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
3b20: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
3b30: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
3b40: 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c puts -nonewl
3b50: 69 6e 65 20 24 66 20 7b 70 61 63 6b 61 67 65 20 ine $f {package
3b60: 72 65 71 75 69 72 65 20 74 6c 73 3b 20 74 6c 73 require tls; tls
3b70: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
3b80: 20 61 63 63 65 70 74 20 32 38 32 38 7d 0a 20 20 accept 2828}.
3b90: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3ba0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
3bb0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
3bc0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
3bd0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
3be0: 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 20 after 100.
3bf0: 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 set x [list [ca
3c00: 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d tch {close $f} m
3c10: 73 67 5d 20 24 6d 73 67 5d 0a 20 20 20 20 63 6c sg] $msg]. cl
3c20: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 78 ose $s. set x
3c30: 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 .} {1 {couldn't
3c40: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 open socket: add
3c50: 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 ress already in
3c60: 75 73 65 0a 20 20 20 20 77 68 69 6c 65 20 65 78 use. while ex
3c70: 65 63 75 74 69 6e 67 0a 22 3a 3a 73 6f 63 6b 65 ecuting."::socke
3c80: 74 20 2d 73 65 72 76 65 72 20 7b 74 6c 73 3a 3a t -server {tls::
3c90: 5f 61 63 63 65 70 74 20 7b 2d 73 65 72 76 65 72 _accept {-server
3ca0: 20 31 7d 20 61 63 63 65 70 74 7d 20 32 38 32 38 1} accept} 2828
3cb0: 22 0a 20 20 20 20 28 22 65 76 61 6c 22 20 62 6f ". ("eval" bo
3cc0: 64 79 20 6c 69 6e 65 20 31 29 0a 20 20 20 20 69 dy line 1). i
3cd0: 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 68 nvoked from with
3ce0: 69 6e 0a 22 65 76 61 6c 20 3a 3a 73 6f 63 6b 65 in."eval ::socke
3cf0: 74 20 24 73 6f 70 74 73 22 0a 20 20 20 20 28 70 t $sopts". (p
3d00: 72 6f 63 65 64 75 72 65 20 22 74 6c 73 3a 3a 73 rocedure "tls::s
3d10: 6f 63 6b 65 74 22 20 6c 69 6e 65 20 36 32 29 0a ocket" line 62).
3d20: 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f 6d invoked from
3d30: 20 77 69 74 68 69 6e 0a 22 74 6c 73 3a 3a 73 6f within."tls::so
3d40: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
3d50: 65 70 74 20 32 38 32 38 22 0a 20 20 20 20 28 66 ept 2828". (f
3d60: 69 6c 65 20 22 73 63 72 69 70 74 22 20 6c 69 6e ile "script" lin
3d70: 65 20 31 29 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 e 1)}}..test soc
3d80: 6b 65 74 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 20 ket-2.10 {close
3d90: 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 70 on accept, accep
3da0: 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 73 ted socket lives
3db0: 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 } {socket pcCras
3dc0: 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e h} {. set don
3dd0: 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d 65 e 0. set time
3de0: 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 r [after 20000 "
3df0: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
3e00: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 73 20 ut"]. set ss
3e10: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
3e20: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 30 rver accept 2830
3e30: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
3e40: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
3e50: 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24 73 bal ss..close $s
3e60: 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 s..fileevent $s
3e70: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 readable "readit
3e80: 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 72 65 $s"..fconfigure
3e90: 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20 20 $s -trans lf.
3ea0: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 }. proc rea
3eb0: 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 dit {s} {..globa
3ec0: 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 73 0a l done..gets $s.
3ed0: 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 64 .close $s..set d
3ee0: 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 one 1. }.
3ef0: 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 set cs [tls::soc
3f00: 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 ket [info hostna
3f10: 6d 65 5d 20 32 38 33 30 5d 0a 20 20 20 20 70 75 me] 2830]. pu
3f20: 74 73 20 24 63 73 20 68 65 6c 6c 6f 0a 20 20 20 ts $cs hello.
3f30: 20 63 6c 6f 73 65 20 24 63 73 0a 20 20 20 20 76 close $cs. v
3f40: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 wait done. af
3f50: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
3f60: 72 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d r. set done.}
3f70: 20 31 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 1.test socket-2
3f80: 2e 31 31 20 7b 64 65 74 65 63 74 69 6e 67 20 6e .11 {detecting n
3f90: 65 77 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 74 ew data} {socket
3fa0: 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 pcCrash} {.
3fb0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
3fc0: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 6f p} {..global so
3fd0: 63 6b 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 0a ck..set sock $s.
3fe0: 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 }.. set s
3ff0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
4000: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 34 30 erver accept 240
4010: 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 20 0]. set sock
4020: 22 22 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 "". set s2 [t
4030: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
4040: 2e 30 2e 31 20 32 34 30 30 5d 0a 20 20 20 20 76 .0.1 2400]. v
4050: 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 wait sock. pu
4060: 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 ts $s2 one. f
4070: 6c 75 73 68 20 24 73 32 0a 20 20 20 20 61 66 74 lush $s2. aft
4080: 65 72 20 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 er 500. fconf
4090: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
40a0: 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 65 74 20 cking 0. set
40b0: 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 6f result [gets $so
40c0: 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 ck]. lappend
40d0: 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 6f result [gets $so
40e0: 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 ck]. fconfigu
40f0: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
4100: 6e 67 20 31 0a 20 20 20 20 70 75 74 73 20 24 73 ng 1. puts $s
4110: 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 2 two. flush
4120: 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 $s2. fconfigu
4130: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
4140: 6e 67 20 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 ng 0. lappend
4150: 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 result [gets $s
4160: 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 ock]. fconfig
4170: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
4180: 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 ing 1. close
4190: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
41a0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b . close $sock
41b0: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
41c0: 7d 20 7b 6f 6e 65 20 7b 7d 20 74 77 6f 7d 0a 0a } {one {} two}..
41d0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 33 2e 31 .test socket-3.1
41e0: 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 {socket conflic
41f0: 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f t} {socket stdio
4200: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
4210: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
4220: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
4230: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
4240: 7b 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 {..set f [tls::s
4250: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4260: 63 65 70 74 20 32 38 32 38 5d 0a 09 70 75 74 73 cept 2828]..puts
4270: 20 72 65 61 64 79 0a 09 67 65 74 73 20 73 74 64 ready..gets std
4280: 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 in..close $f.
4290: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
42a0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
42b0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
42c0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
42d0: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 67 65 74 pt]" r+]. get
42e0: 73 20 24 66 0a 20 20 20 20 73 65 74 20 78 20 5b s $f. set x [
42f0: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
4300: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4310: 20 61 63 63 65 70 74 20 32 38 32 38 7d 20 6d 73 accept 2828} ms
4320: 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 g] \...$msg].
4330: 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 puts $f bye.
4340: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4350: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
4360: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
4370: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
4380: 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 73 in use}}..test s
4390: 6f 63 6b 65 74 2d 33 2e 32 20 7b 73 65 72 76 65 ocket-3.2 {serve
43a0: 72 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 r with several c
43b0: 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 lients} {socket
43c0: 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b stdio pcCrash} {
43d0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
43e0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
43f0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
4400: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
4410: 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 set t1 [after 30
4420: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
4430: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 32 20 5b _out"]..set t2 [
4440: 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 after 31000 "set
4450: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 x timed_out"]..
4460: 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 set t3 [after 32
4470: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
4480: 5f 6f 75 74 22 5d 0a 09 73 65 74 20 63 6f 75 6e _out"]..set coun
4490: 74 65 72 20 30 0a 09 73 65 74 20 73 20 5b 74 6c ter 0..set s [tl
44a0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
44b0: 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 r accept 2828]..
44c0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
44d0: 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 p} {.. filee
44e0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
44f0: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
4500: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4510: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
4520: 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f ne..}..proc echo
4530: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f {s} {.. glo
4540: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
4550: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
4560: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
4570: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
4580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4590: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 close $s.
45a0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
45b0: 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 done.
45c0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
45d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 put
45e0: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
45f0: 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 }..}..puts
4600: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
4610: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 after cancel $t1
4620: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
4630: 20 63 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 61 cancel $t2..vwa
4640: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
4650: 65 6c 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 73 el $t3..close $s
4660: 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a ..puts $x. }.
4670: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
4680: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
4690: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
46a0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
46b0: 22 20 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 " r+]. set x
46c0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 73 65 [gets $f]. se
46d0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
46e0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 t 127.0.0.1 2828
46f0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4700: 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 $s1 -buffering
4710: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 line. set s2
4720: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
4730: 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 .0.0.1 2828].
4740: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 fconfigure $s2
4750: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4760: 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a set s3 [tls:
4770: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
4780: 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 2828]. fcon
4790: 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 figure $s3 -buff
47a0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 ering line. f
47b0: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
47c0: 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d < 100} {incr i}
47d0: 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c {..puts $s1 hel
47e0: 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a lo,s1..gets $s1.
47f0: 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c .puts $s2 hello,
4800: 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 s2..gets $s2..pu
4810: 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a ts $s3 hello,s3.
4820: 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a .gets $s3. }.
4830: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
4840: 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 close $s2.
4850: 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 6c 61 close $s3. la
4860: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
4870: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
4880: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
4890: 79 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 73 6f y done}..test so
48a0: 63 6b 65 74 2d 34 2e 31 20 7b 73 65 72 76 65 72 cket-4.1 {server
48b0: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c with several cl
48c0: 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 ients} {socket s
48d0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
48e0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
48f0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
4900: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
4910: 20 24 66 20 7b 0a 09 67 65 74 73 20 73 74 64 69 $f {..gets stdi
4920: 6e 0a 09 73 65 74 20 73 20 5b 73 6f 63 6b 65 74 n..set s [socket
4930: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 127.0.0.1 2828]
4940: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
4950: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4960: 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b .for {set i 0} {
4970: 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 $i < 100} {incr
4980: 69 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 i} {.. puts $
4990: 73 20 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 74 s hello.. get
49a0: 73 20 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 s $s..}..close $
49b0: 73 0a 09 70 75 74 73 20 62 79 65 0a 09 67 65 74 s..puts bye..get
49c0: 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 s stdin. }.
49d0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
49e0: 65 74 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c et p1 [open "|[l
49f0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
4a00: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
4a10: 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 r+]. fconfig
4a20: 75 72 65 20 24 70 31 20 2d 62 75 66 66 65 72 69 ure $p1 -bufferi
4a30: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
4a40: 70 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 p2 [open "|[list
4a50: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
4a60: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b test script]" r+
4a70: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4a80: 20 24 70 32 20 2d 62 75 66 66 65 72 69 6e 67 20 $p2 -buffering
4a90: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 33 20 line. set p3
4aa0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
4ab0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
4ac0: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
4ad0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 fconfigure $p
4ae0: 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 3 -buffering lin
4af0: 65 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 e. proc accep
4b00: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f t {s a p} {..fco
4b10: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
4b20: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 ering line..file
4b30: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
4b40: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
4b50: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
4b60: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 echo {s} {..glob
4b70: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 73 65 74 al x. set
4b80: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
4b90: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
4ba0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
4bb0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 close $s.
4bc0: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
4bd0: 0a 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 . } else
4be0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 {. pu
4bf0: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
4c00: 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 }. }. set
4c10: 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 t1 [after 30000
4c20: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
4c30: 74 22 5d 0a 20 20 20 20 73 65 74 20 74 32 20 5b t"]. set t2 [
4c40: 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 after 31000 "set
4c50: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
4c60: 20 20 20 73 65 74 20 74 33 20 5b 61 66 74 65 72 set t3 [after
4c70: 20 33 32 30 30 30 20 22 73 65 74 20 78 20 74 69 32000 "set x ti
4c80: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 med_out"]. se
4c90: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
4ca0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4cb0: 32 38 32 38 5d 0a 20 20 20 20 70 75 74 73 20 24 2828]. puts $
4cc0: 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 p1 open. puts
4cd0: 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 75 $p2 open. pu
4ce0: 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 20 ts $p3 open.
4cf0: 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 vwait x. vwai
4d00: 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a t x. vwait x.
4d10: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
4d20: 20 24 74 31 0a 20 20 20 20 61 66 74 65 72 20 63 $t1. after c
4d30: 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 61 66 ancel $t2. af
4d40: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 20 ter cancel $t3.
4d50: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
4d60: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
4d70: 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 20 pend l [list p1
4d80: 5b 67 65 74 73 20 24 70 31 5d 20 24 78 5d 0a 20 [gets $p1] $x].
4d90: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
4da0: 73 74 20 70 32 20 5b 67 65 74 73 20 24 70 32 5d st p2 [gets $p2]
4db0: 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 $x]. lappend
4dc0: 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 74 l [list p3 [get
4dd0: 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 70 s $p3] $x]. p
4de0: 75 74 73 20 24 70 31 20 62 79 65 0a 20 20 20 20 uts $p1 bye.
4df0: 70 75 74 73 20 24 70 32 20 62 79 65 0a 20 20 20 puts $p2 bye.
4e00: 20 70 75 74 73 20 24 70 33 20 62 79 65 0a 20 20 puts $p3 bye.
4e10: 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 20 close $p1.
4e20: 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 63 6c close $p2. cl
4e30: 6f 73 65 20 24 70 33 0a 20 20 20 20 73 65 74 20 ose $p3. set
4e40: 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 6f 6e l.} {{p1 bye don
4e50: 65 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e 65 7d e} {p2 bye done}
4e60: 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d 7d 0a {p3 bye done}}.
4e70: 74 65 73 74 20 73 6f 63 6b 65 74 2d 34 2e 32 20 test socket-4.2
4e80: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
4e90: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
4ea0: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f bers, htons} {so
4eb0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
4ec0: 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b 63 61 x ok. if {[ca
4ed0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
4ee0: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 -server dodo 0x
4ef0: 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 3000} msg]} {..s
4f00: 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 et x $msg. }
4f10: 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d else {..close $m
4f20: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
4f30: 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 73 6f x.} ok..test so
4f40: 63 6b 65 74 2d 35 2e 31 20 7b 62 79 74 65 20 6f cket-5.1 {byte o
4f50: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
4f60: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
4f70: 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 tons} \..{socket
4f80: 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f unixOnly notRoo
4f90: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b t} {. set x {
4fa0: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
4fb0: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
4fc0: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
4fd0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
4fe0: 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 7d 20 erver dodo 0x1}
4ff0: 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 msg]} {.
5000: 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f set x {htons pro
5010: 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 blem, should be
5020: 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 disallowed, are
5030: 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 you running as S
5040: 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a U?}..close $msg.
5050: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a }. set x.
5060: 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e } {couldn't open
5070: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
5080: 65 72 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d er}.test socket-
5090: 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.2 {byte order
50a0: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
50b0: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
50c0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
50d0: 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 set x {couldn't
50e0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 open socket: por
50f0: 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 t number too hig
5100: 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 h}. if {![cat
5110: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
5120: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 -server dodo 0x1
5130: 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 0000} msg]} {..s
5140: 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c et x {port resol
5150: 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 ution problem, s
5160: 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f hould be disallo
5170: 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 wed}..close $msg
5180: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
5190: 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 .} {couldn't ope
51a0: 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e n socket: port n
51b0: 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a umber too high}.
51c0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 35 2e 33 20 test socket-5.3
51d0: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
51e0: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
51f0: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 bers, htons} \..
5200: 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 {socket unixOnly
5210: 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 notRoot} {.
5220: 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 set x {couldn't
5230: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 open socket: not
5240: 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b owner}. if {
5250: 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f ![catch {tls::so
5260: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
5270: 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 o 21} msg]} {..s
5280: 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 et x {htons prob
5290: 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 lem, should be d
52a0: 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 isallowed, are y
52b0: 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 ou running as SU
52c0: 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 ?}..close $msg.
52d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
52e0: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
52f0: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
5300: 72 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d r}..test socket-
5310: 36 2e 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 6.1 {accept call
5320: 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 back error} {soc
5330: 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 ket stdio pcCras
5340: 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 h} {. removeF
5350: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
5360: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
5370: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
5380: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
5390: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 require tls..get
53a0: 73 20 73 74 64 69 6e 0a 09 74 6c 73 3a 3a 73 6f s stdin..tls::so
53b0: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
53c0: 38 34 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 848. }. cl
53d0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
53e0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
53f0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5400: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5410: 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 proc bgerror
5420: 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 args {..global
5430: 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 x..set x $args.
5440: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 }. proc ac
5450: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 cept {s a p} {ex
5460: 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 pr 10 / 0}. s
5470: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
5480: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
5490: 20 32 38 34 38 5d 0a 20 20 20 20 70 75 74 73 20 2848]. puts
54a0: 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f $f hello. clo
54b0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 74 69 se $f. set ti
54c0: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
54d0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
54e0: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
54f0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
5500: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
5510: 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 e $s. rename
5520: 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 bgerror {}. s
5530: 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 et x.} {{divide
5540: 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 by zero}}..test
5550: 73 6f 63 6b 65 74 2d 37 2e 31 20 7b 74 65 73 74 socket-7.1 {test
5560: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
5570: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
5580: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
5590: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
55a0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
55b0: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
55c0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 74 6c 73 puts $f {..tls
55d0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
55e0: 20 61 63 63 65 70 74 20 32 38 32 30 0a 09 70 72 accept 2820..pr
55f0: 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b oc accept args {
5600: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
5610: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
5620: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 }..puts ready..s
5630: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
5640: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
5650: 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 ed_out"]..vwait
5660: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
5670: 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 $timer. }.
5680: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
5690: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
56a0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
56b0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
56c0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
56d0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
56e0: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
56f0: 38 32 30 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 820]. set p [
5700: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 fconfigure $s -p
5710: 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f eername]. clo
5720: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
5730: 24 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a $f. set l "".
5740: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 lappend l [s
5750: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c tring compare [l
5760: 69 6e 64 65 78 20 24 70 20 30 5d 20 31 32 37 2e index $p 0] 127.
5770: 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 0.0.1]. lappe
5780: 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d nd l [string com
5790: 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 pare [lindex $p
57a0: 32 5d 20 32 38 32 30 5d 0a 20 20 20 20 6c 61 70 2] 2820]. lap
57b0: 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 pend l [llength
57c0: 24 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a 74 65 $p].} {0 0 3}.te
57d0: 73 74 20 73 6f 63 6b 65 74 2d 37 2e 32 20 7b 74 st socket-7.2 {t
57e0: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
57f0: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
5800: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 {socket stdio pc
5810: 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d Crash} {. rem
5820: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
5830: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
5840: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
5850: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
5860: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 require tls..tls
5870: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
5880: 20 61 63 63 65 70 74 20 32 38 32 31 0a 09 70 72 accept 2821..pr
5890: 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b oc accept args {
58a0: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
58b0: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
58c0: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 }..puts ready..s
58d0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
58e0: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
58f0: 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 ed_out"]..vwait
5900: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
5910: 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 $timer. }.
5920: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
5930: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
5940: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
5950: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
5960: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
5970: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
5980: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
5990: 38 32 31 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 821]. set p [
59a0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
59b0: 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f ockname]. clo
59c0: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
59d0: 24 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a $f. set l "".
59e0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
59f0: 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 6c length $p]. l
5a00: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 append l [lindex
5a10: 20 24 70 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 $p 0]. lappe
5a20: 6e 64 20 6c 20 5b 65 78 70 72 20 5b 6c 69 6e 64 nd l [expr [lind
5a30: 65 78 20 24 70 20 32 5d 20 3d 3d 20 32 38 32 31 ex $p 2] == 2821
5a40: 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 ].} {3 127.0.0.1
5a50: 20 30 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 0}.test socket-
5a60: 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 7.3 {testing soc
5a70: 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 ket specific opt
5a80: 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b ions} {socket} {
5a90: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
5aa0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
5ab0: 61 63 63 65 70 74 20 32 38 32 32 5d 0a 20 20 20 accept 2822].
5ac0: 20 73 65 74 20 6c 20 5b 66 63 6f 6e 66 69 67 75 set l [fconfigu
5ad0: 72 65 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 re $s]. close
5ae0: 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 $s. update.
5af0: 20 20 20 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d 20 llength $l.}
5b00: 31 32 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 12.test socket-7
5b10: 2e 34 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .4 {testing sock
5b20: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
5b30: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 ons} {socket pcC
5b40: 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 rash} {. set
5b50: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
5b60: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
5b70: 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 23]. proc acc
5b80: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
5b90: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b lobal x..set x [
5ba0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
5bb0: 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 ockname]..close
5bc0: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 $s. }. set
5bd0: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
5be0: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
5bf0: 20 32 38 32 33 5d 0a 20 20 20 20 73 65 74 20 74 2823]. set t
5c00: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
5c10: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
5c20: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut"]. vwait x
5c30: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
5c40: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
5c50: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
5c60: 24 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 $s1. set l ""
5c70: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
5c80: 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c lindex $x 2] [ll
5c90: 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 32 38 32 ength $x].} {282
5ca0: 33 20 33 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 3 3}..test socke
5cb0: 74 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 t-7.5 {testing s
5cc0: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
5cd0: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
5ce0: 75 6e 69 78 4f 72 50 63 20 70 63 43 72 61 73 68 unixOrPc pcCrash
5cf0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
5d00: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
5d10: 65 72 20 61 63 63 65 70 74 20 32 38 32 39 5d 0a er accept 2829].
5d20: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
5d30: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
5d40: 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e l x..set x [fcon
5d50: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e figure $s -sockn
5d60: 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 ame]..close $s.
5d70: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
5d80: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
5d90: 2e 30 2e 30 2e 31 20 32 38 32 39 5d 0a 20 20 20 .0.0.1 2829].
5da0: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
5db0: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
5dc0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
5dd0: 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 wait x. after
5de0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
5df0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
5e00: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 close $s1. se
5e10: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
5e20: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 nd l [lindex $x
5e30: 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 0] [lindex $x 2]
5e40: 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 [llength $x].}
5e50: 7b 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 20 {127.0.0.1 2829
5e60: 33 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 3}..test socket-
5e70: 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 8.1 {testing -as
5e80: 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b ync flag on sock
5e90: 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 ets} {socket pcC
5ea0: 72 61 73 68 7d 20 7b 0a 20 20 20 20 23 20 4e 4f rash} {. # NO
5eb0: 54 45 3a 20 54 68 69 73 20 74 65 73 74 20 6d 61 TE: This test ma
5ec0: 79 20 66 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 y fail on some S
5ed0: 6f 6c 61 72 69 73 20 32 2e 34 20 73 79 73 74 65 olaris 2.4 syste
5ee0: 6d 73 2e 20 49 66 20 69 74 20 64 6f 65 73 2c 0a ms. If it does,.
5ef0: 20 20 20 20 23 20 63 68 65 63 6b 20 74 68 61 74 # check that
5f00: 20 79 6f 75 20 68 61 76 65 20 74 68 65 73 65 20 you have these
5f10: 70 61 74 63 68 65 73 20 69 6e 73 74 61 6c 6c 65 patches installe
5f20: 64 20 28 75 73 69 6e 67 20 73 68 6f 77 72 65 76 d (using showrev
5f30: 20 2d 70 29 3a 0a 20 20 20 20 23 0a 20 20 20 20 -p):. #.
5f40: 23 20 31 30 31 39 30 37 2d 30 35 2c 20 31 30 31 # 101907-05, 101
5f50: 39 32 35 2d 30 32 2c 20 31 30 31 39 34 35 2d 31 925-02, 101945-1
5f60: 34 2c 20 31 30 31 39 35 39 2d 30 33 2c 20 31 30 4, 101959-03, 10
5f70: 31 39 36 39 2d 30 35 2c 20 31 30 31 39 37 33 2d 1969-05, 101973-
5f80: 30 33 2c 0a 20 20 20 20 23 20 31 30 31 39 37 37 03,. # 101977
5f90: 2d 30 33 2c 20 31 30 31 39 38 31 2d 30 32 2c 20 -03, 101981-02,
5fa0: 31 30 31 39 38 35 2d 30 31 2c 20 31 30 32 30 30 101985-01, 10200
5fb0: 31 2d 30 33 2c 20 31 30 32 30 30 33 2d 30 31 2c 1-03, 102003-01,
5fc0: 20 31 30 32 30 30 37 2d 30 31 2c 0a 20 20 20 20 102007-01,.
5fd0: 23 20 31 30 32 30 31 31 2d 30 32 2c 20 31 30 32 # 102011-02, 102
5fe0: 30 32 34 2d 30 31 2c 20 31 30 32 30 33 39 2d 30 024-01, 102039-0
5ff0: 31 2c 20 31 30 32 30 34 34 2d 30 31 2c 20 31 30 1, 102044-01, 10
6000: 32 30 34 38 2d 30 31 2c 20 31 30 32 30 36 32 2d 2048-01, 102062-
6010: 30 33 2c 0a 20 20 20 20 23 20 31 30 32 30 36 36 03,. # 102066
6020: 2d 30 34 2c 20 31 30 32 30 37 30 2d 30 31 2c 20 -04, 102070-01,
6030: 31 30 32 31 30 35 2d 30 31 2c 20 31 30 32 31 35 102105-01, 10215
6040: 33 2d 30 33 2c 20 31 30 32 32 31 36 2d 30 31 2c 3-03, 102216-01,
6050: 20 31 30 32 32 33 32 2d 30 31 2c 0a 20 20 20 20 102232-01,.
6060: 23 20 31 30 31 38 37 38 2d 30 33 2c 20 31 30 31 # 101878-03, 101
6070: 38 37 39 2d 30 31 2c 20 31 30 31 38 38 30 2d 30 879-01, 101880-0
6080: 33 2c 20 31 30 31 39 33 33 2d 30 31 2c 20 31 30 3, 101933-01, 10
6090: 31 39 35 30 2d 30 31 2c 20 31 30 32 30 33 30 2d 1950-01, 102030-
60a0: 30 31 2c 0a 20 20 20 20 23 20 31 30 32 30 35 37 01,. # 102057
60b0: 2d 30 38 2c 20 31 30 32 31 34 30 2d 30 31 2c 20 -08, 102140-01,
60c0: 31 30 31 39 32 30 2d 30 32 2c 20 31 30 31 39 32 101920-02, 10192
60d0: 31 2d 30 39 2c 20 31 30 31 39 32 32 2d 30 37 2c 1-09, 101922-07,
60e0: 20 31 30 31 39 32 33 2d 30 33 0a 20 20 20 20 23 101923-03. #
60f0: 0a 20 20 20 20 23 20 49 66 20 61 66 74 65 72 20 . # If after
6100: 69 6e 73 74 61 6c 6c 69 6e 67 20 74 68 65 73 65 installing these
6110: 20 70 61 74 63 68 65 73 20 79 6f 75 20 61 72 65 patches you are
6120: 20 73 74 69 6c 6c 20 65 78 70 65 72 69 65 6e 63 still experienc
6130: 69 6e 67 20 61 0a 20 20 20 20 23 20 70 72 6f 62 ing a. # prob
6140: 6c 65 6d 2c 20 70 6c 65 61 73 65 20 65 6d 61 69 lem, please emai
6150: 6c 20 6a 79 6c 40 65 6e 67 2e 73 75 6e 2e 63 6f l jyl@eng.sun.co
6160: 6d 2e 20 57 65 20 68 61 76 65 20 6e 6f 74 20 6f m. We have not o
6170: 62 73 65 72 76 65 64 20 74 68 69 73 0a 20 20 20 bserved this.
6180: 20 23 20 66 61 69 6c 75 72 65 20 6f 6e 20 53 6f # failure on So
6190: 6c 61 72 69 73 20 32 2e 35 2c 20 73 6f 20 61 6e laris 2.5, so an
61a0: 6f 74 68 65 72 20 6f 70 74 69 6f 6e 20 28 69 6e other option (in
61b0: 73 74 65 61 64 20 6f 66 20 69 6e 73 74 61 6c 6c stead of install
61c0: 69 6e 67 0a 20 20 20 20 23 20 74 68 65 73 65 20 ing. # these
61d0: 70 61 74 63 68 65 73 29 20 69 73 20 74 6f 20 75 patches) is to u
61e0: 70 67 72 61 64 65 20 74 6f 20 53 6f 6c 61 72 69 pgrade to Solari
61f0: 73 20 32 2e 35 2e 0a 20 20 20 20 73 65 74 20 73 s 2.5.. set s
6200: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
6210: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
6220: 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 0]. proc acce
6230: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
6240: 6f 62 61 6c 20 78 0a 09 70 75 74 73 20 24 73 20 obal x..puts $s
6250: 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 bye..close $s..s
6260: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a et x done. }.
6270: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
6280: 3a 73 6f 63 6b 65 74 20 2d 61 73 79 6e 63 20 5b :socket -async [
6290: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 info hostname] 2
62a0: 38 33 30 5d 0a 20 20 20 20 76 77 61 69 74 20 78 830]. vwait x
62b0: 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65 74 73 . set z [gets
62c0: 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s1]. close
62d0: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
62e0: 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 . set z.} bye
62f0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 39 2e ..test socket-9.
6300: 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 1 {testing spuri
6310: 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 ous events} {soc
6320: 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 ket pcCrash} {.
6330: 20 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 set len 0.
6340: 20 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a set spurious 0.
6350: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
6360: 20 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 proc readlitt
6370: 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c le {s} {..global
6380: 20 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c spurious done l
6390: 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 en..set l [read
63a0: 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 $s 1]..if {[stri
63b0: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d ng length $l] ==
63c0: 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 0} {.. if {!
63d0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e [eof $s]} {...in
63e0: 63 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 cr spurious..
63f0: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 } else {...clos
6400: 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 e $s...set done
6410: 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 1.. }..} else
6420: 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e {.. incr len
6430: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 [string length
6440: 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $l]..}. }.
6450: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
6460: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
6470: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
6480: 20 6e 6f 6e 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 none -blocking
6490: 6f 66 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 off..fileevent $
64a0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
64b0: 20 72 65 61 64 6c 69 74 74 6c 65 20 24 73 5d 0a readlittle $s].
64c0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
64d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
64e0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 31 rver accept 2831
64f0: 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 ]. set c [tls
6500: 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 ::socket [info h
6510: 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 5d 0a 20 ostname] 2831].
6520: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
6530: 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 38 39 ne $c 0123456789
6540: 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 0123456789012345
6550: 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 6789012345678901
6560: 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 23456789. clo
6570: 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 74 69 se $c. set ti
6580: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
6590: 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 "set done timed
65a0: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
65b0: 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 done. after
65c0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
65d0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c close $s. l
65e0: 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c ist $spurious $l
65f0: 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 en.} {0 50}..tes
6600: 74 20 73 6f 63 6b 65 74 2d 39 2e 32 20 7b 74 65 t socket-9.2 {te
6610: 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 sting async writ
6620: 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 e, fileevents, f
6630: 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b lush on close} {
6640: 73 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d 20 socket pcCrash}
6650: 7b 0a 20 20 20 20 73 65 74 20 66 69 72 73 74 62 {. set firstb
6660: 6c 6f 63 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 lock "". for
6670: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
6680: 35 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 73 65 74 5} {incr i} {set
6690: 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 firstblock "a$f
66a0: 69 72 73 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 irstblock$firstb
66b0: 6c 6f 63 6b 22 7d 0a 20 20 20 20 73 65 74 20 73 lock"}. set s
66c0: 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a 20 20 econdblock "".
66d0: 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 for {set i 0}
66e0: 7b 24 69 20 3c 20 31 36 7d 20 7b 69 6e 63 72 20 {$i < 16} {incr
66f0: 69 7d 20 7b 0a 09 73 65 74 20 73 65 63 6f 6e 64 i} {..set second
6700: 62 6c 6f 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 block "b$secondb
6710: 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b lock$secondblock
6720: 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 ". }. set
6730: 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d l [tls::socket -
6740: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
6750: 33 32 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 32]. proc acc
6760: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
6770: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
6780: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c ocking 0 -transl
6790: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
67a0: 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 2d size 16384 \...-
67b0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
67c0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
67d0: 64 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 dable "readable
67e0: 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s". }. pr
67f0: 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 oc readable {s}
6800: 7b 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 {..set l [gets $
6810: 73 5d 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 s]..fileevent $s
6820: 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 readable {}..af
6830: 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 ter 1000 respond
6840: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s. }. pr
6850: 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b oc respond {s} {
6860: 0a 09 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c ..global firstbl
6870: 6f 63 6b 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 ock..puts -nonew
6880: 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c line $s $firstbl
6890: 6f 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 20 ock..after 1000
68a0: 77 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 20 writedata $s.
68b0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 }. proc writ
68c0: 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f edata {s} {..glo
68d0: 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a bal secondblock.
68e0: 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 .puts -nonewline
68f0: 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b $s $secondblock
6900: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
6910: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6920: 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f :socket [info ho
6930: 73 74 6e 61 6d 65 5d 20 32 38 33 32 5d 0a 20 20 stname] 2832].
6940: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
6950: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 -blocking 0 -tra
6960: 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 ns lf -buffering
6970: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f line. set co
6980: 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 unt 0. puts $
6990: 73 20 68 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 s hello. proc
69a0: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
69b0: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
69c0: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
69d0: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
69e0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
69f0: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
6a00: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
6a10: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
6a20: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 66 69 6c .}. }. fil
6a30: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
6a40: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 le "readit $s".
6a50: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
6a60: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 ter 10000 "set d
6a70: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a one timed_out"].
6a80: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
6a90: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
6aa0: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
6ab0: 20 24 6c 0a 20 20 20 20 73 65 74 20 63 6f 75 6e $l. set coun
6ac0: 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 t.} 65566..test
6ad0: 73 6f 63 6b 65 74 2d 39 2e 33 20 7b 74 65 73 74 socket-9.3 {test
6ae0: 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 ing EOF stickyne
6af0: 73 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 ss} {socket pcCr
6b00: 61 73 68 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 ash} {. proc
6b10: 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d count_to_eof {s}
6b20: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 {..global count
6b30: 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 done timer..set
6b40: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 l [gets $s]..if
6b50: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
6b60: 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 incr count..
6b70: 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 if {$count >
6b80: 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 9} {...close $s.
6b90: 09 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a ..set done true.
6ba0: 09 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 ..set count {eof
6bb0: 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 is sticky}...af
6bc0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
6bd0: 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 r.. }..}.
6be0: 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 72 }. proc timer
6bf0: 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 proc {} {..globa
6c00: 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 l done count c..
6c10: 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 set done true..s
6c20: 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 et count {timer
6c30: 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 went off, eof is
6c40: 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c not sticky}..cl
6c50: 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 0a 20 20 ose $c. }..
6c60: 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 set count 0.
6c70: 20 20 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 set done false
6c80: 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 5f . proc write_
6c90: 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b then_close {s} {
6ca0: 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 ..puts $s bye..c
6cb0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
6cc0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
6cd0: 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 a p} {..fconfig
6ce0: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
6cf0: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
6d00: 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e ion lf..fileeven
6d10: 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 22 77 t $s writable "w
6d20: 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 rite_then_close
6d30: 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s". }. se
6d40: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
6d50: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
6d60: 32 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 20 2833]. set c
6d70: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e [tls::socket [in
6d80: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 fo hostname] 283
6d90: 33 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 3]. fconfigur
6da0: 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f e $c -blocking o
6db0: 66 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 ff -buffering li
6dc0: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
6dd0: 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 lf. fileevent
6de0: 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f $c readable "co
6df0: 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 22 0a 20 unt_to_eof $c".
6e00: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
6e10: 74 65 72 20 31 30 30 30 20 74 69 6d 65 72 70 72 ter 1000 timerpr
6e20: 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f oc]. vwait do
6e30: 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a ne. close $s.
6e40: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 set count.}
6e50: 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a {eof is sticky}.
6e60: 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 .removeFile scri
6e70: 70 74 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d pt..test socket-
6e80: 31 30 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 10.1 {testing so
6e90: 63 6b 65 74 20 61 63 63 65 70 74 20 63 61 6c 6c cket accept call
6ea0: 62 61 63 6b 20 65 72 72 6f 72 20 68 61 6e 64 6c back error handl
6eb0: 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 ing} {socket pcC
6ec0: 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 rash} {. set
6ed0: 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 goterror 0. p
6ee0: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 roc bgerror args
6ef0: 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f {global goterro
6f00: 72 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 r; set goterror
6f10: 31 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 1}. set s [tl
6f20: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6f30: 72 20 61 63 63 65 70 74 20 32 38 39 38 5d 0a 20 r accept 2898].
6f40: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
6f50: 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 s a p} {close $s
6f60: 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 ; error}. set
6f70: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
6f80: 31 32 37 2e 30 2e 30 2e 31 20 32 38 39 38 5d 0a 127.0.0.1 2898].
6f90: 20 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 vwait goterr
6fa0: 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a or. close $s.
6fb0: 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 close $c.
6fc0: 20 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 set goterror.}
6fd0: 31 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 1..test socket-1
6fe0: 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 1.1 {tcp connect
6ff0: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ion} {socket doT
7000: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
7010: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
7020: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
7030: 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 ocket9_1_test_se
7040: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
7050: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
7060: 20 32 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 2834]..proc acc
7070: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
7080: 20 20 20 70 75 74 73 20 24 73 20 64 6f 6e 65 0a puts $s done.
7090: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d . close $s..}
70a0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
70b0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 [tls::socket $r
70c0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 emoteServerIP 28
70d0: 33 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 34]. set r [g
70e0: 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ets $s]. clos
70f0: 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d e $s. sendCom
7100: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
7110: 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 ket9_1_test_serv
7120: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
7130: 64 6f 6e 65 0a 74 65 73 74 20 73 6f 63 6b 65 74 done.test socket
7140: 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 -11.2 {client sp
7150: 65 63 69 66 69 65 73 20 69 74 73 20 70 6f 72 74 ecifies its port
7160: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
7170: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
7180: 72 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e r} {. if {[in
7190: 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 7d fo exists port]}
71a0: 20 7b 0a 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 {..incr port.
71b0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
71c0: 70 6f 72 74 20 5b 65 78 70 72 20 32 30 34 38 20 port [expr 2048
71d0: 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 + [pid]%1024].
71e0: 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d }. sendComm
71f0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
7200: 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_2_test_server
7210: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
7220: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
7230: 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 5]..proc accept
7240: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 70 {s a p} {.. p
7250: 75 74 73 20 24 73 20 24 70 0a 09 20 20 20 20 63 uts $s $p.. c
7260: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
7270: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
7280: 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 :socket -myport
7290: 24 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 $port $remoteSer
72a0: 76 65 72 49 50 20 32 38 33 35 5d 0a 20 20 20 20 verIP 2835].
72b0: 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a set r [gets $s].
72c0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
72d0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
72e0: 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 ose $socket9_2_t
72f0: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
7300: 69 66 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d if {$r == $port}
7310: 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 6f {..set result o
7320: 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 k. } else {..
7330: 73 65 74 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 set result broke
7340: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 n. }. set
7350: 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a 74 65 73 74 result.} ok.test
7360: 20 73 6f 63 6b 65 74 2d 31 31 2e 33 20 7b 74 72 socket-11.3 {tr
7370: 79 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c ying to connect,
7380: 20 6e 6f 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 no server} {soc
7390: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
73a0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
73b0: 20 20 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b set status ok
73c0: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
73d0: 20 7b 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f {set s [tls::so
73e0: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
73f0: 65 72 49 70 20 32 38 33 36 5d 7d 5d 7d 20 7b 0a erIp 2836]}]} {.
7400: 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 .if {![catch {ge
7410: 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 ts $s}]} {..
7420: 73 65 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 set status broke
7430: 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 n..}..close $s.
7440: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 }. set sta
7450: 74 75 73 0a 7d 20 6f 6b 0a 74 65 73 74 20 73 6f tus.} ok.test so
7460: 63 6b 65 74 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 cket-11.4 {remot
7470: 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 e echo, one line
7480: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
7490: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
74a0: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d r} {. sendCom
74b0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
74c0: 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 et10_6_test_serv
74d0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
74e0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
74f0: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
7500: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
7510: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
7520: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
7530: 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 o $s].. fconf
7540: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
7550: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
7560: 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 ation crlf..}..p
7570: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
7580: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
7590: 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f $s].. if {[eo
75a0: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
75b0: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 $s.. } else
75c0: 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 {...puts $s $l..
75d0: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
75e0: 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 set f [tls::s
75f0: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
7600: 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 verIP 2836].
7610: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 74 fconfigure $f -t
7620: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 ranslation crlf
7630: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
7640: 20 20 20 20 70 75 74 73 20 24 66 20 68 65 6c 6c puts $f hell
7650: 6f 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 o. set r [get
7660: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
7670: 24 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 $f. sendComma
7680: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
7690: 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 65 t10_6_test_serve
76a0: 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 68 r}. set r.} h
76b0: 65 6c 6c 6f 0a 74 65 73 74 20 73 6f 63 6b 65 74 ello.test socket
76c0: 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 65 20 65 63 -11.5 {remote ec
76d0: 68 6f 2c 20 35 30 20 6c 69 6e 65 73 7d 20 7b 73 ho, 50 lines} {s
76e0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
76f0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
7700: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
7710: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
7720: 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _7_test_server [
7730: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
7740: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d ver accept 2836]
7750: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
7760: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c a p} {.. fil
7770: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
7780: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
7790: 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ].. fconfigur
77a0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
77b0: 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f line -translatio
77c0: 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 n crlf..}..proc
77d0: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
77e0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
77f0: 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 . if {[eof $s
7800: 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a ]} {...close $s.
7810: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
7820: 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 puts $s $l..
7830: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 }..}. }. s
7840: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
7850: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
7860: 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e P 2836]. fcon
7870: 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 figure $f -trans
7880: 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 lation crlf -buf
7890: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
78a0: 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 for {set cnt 0}
78b0: 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 {$cnt < 50} {inc
78c0: 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 r cnt} {..puts $
78d0: 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a f "hello, $cnt".
78e0: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d .if {[string com
78f0: 70 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 22 pare [gets $f] "
7900: 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 3d hello, $cnt"] !=
7910: 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 6b 0} {.. break
7920: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ..}. }. cl
7930: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 43 ose $f. sendC
7940: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
7950: 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 ocket10_7_test_s
7960: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 63 erver}. set c
7970: 6e 74 0a 7d 20 35 30 0a 23 20 4d 61 63 69 6e 74 nt.} 50.# Macint
7980: 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 6e 20 osh sockets can
7990: 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e 20 6f have more than o
79a0: 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 70 6f ne server per po
79b0: 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c 61 74 rt.if {$tcl_plat
79c0: 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 3d form(platform) =
79d0: 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d 20 7b = "macintosh"} {
79e0: 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 . set conflic
79f0: 74 52 65 73 75 6c 74 20 7b 30 20 32 38 33 36 7d tResult {0 2836}
7a00: 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 73 65 .} else {. se
7a10: 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 t conflictResult
7a20: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
7a30: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
7a40: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
7a50: 65 7d 7d 0a 7d 0a 74 65 73 74 20 73 6f 63 6b 65 e}}.}.test socke
7a60: 74 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 74 20 63 t-11.6 {socket c
7a70: 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 onflict} {socket
7a80: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
7a90: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
7aa0: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
7ab0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
7ac0: 70 74 20 32 38 33 36 5d 0a 20 20 20 20 69 66 20 pt 2836]. if
7ad0: 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 {[catch {set s2
7ae0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
7af0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
7b00: 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 ]} msg]} {..set
7b10: 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 31 20 24 result [list 1 $
7b20: 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 73 65 20 msg]. } else
7b30: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c {..set result [l
7b40: 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 20 5b 66 ist 0 [lindex [f
7b50: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 73 configure $s2 -s
7b60: 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c ockname] 2]]..cl
7b70: 6f 73 65 20 24 73 32 0a 20 20 20 20 7d 0a 20 20 ose $s2. }.
7b80: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
7b90: 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 24 63 6f set result.} $co
7ba0: 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a 74 65 73 nflictResult.tes
7bb0: 74 20 73 6f 63 6b 65 74 2d 31 31 2e 37 20 7b 73 t socket-11.7 {s
7bc0: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
7bd0: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 al clients} {soc
7be0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
7bf0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
7c00: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
7c10: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 39 ..set socket10_9
7c20: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
7c30: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
7c40: 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 r accept 2836]..
7c50: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
7c60: 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 p} {.. fconf
7c70: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
7c80: 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 ing line.. fi
7c90: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
7ca0: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
7cb0: 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f s]..}..proc echo
7cc0: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 {s} {.. set
7cd0: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 l [gets $s]..
7ce0: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
7cf0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 ...close $s..
7d00: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 } else {...puts
7d10: 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d $s $l.. }..}
7d20: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
7d30: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 1 [tls::socket $
7d40: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
7d50: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
7d60: 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 ure $s1 -bufferi
7d70: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
7d80: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
7d90: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
7da0: 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2836]. fconfi
7db0: 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 gure $s2 -buffer
7dc0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
7dd0: 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s3 [tls::socket
7de0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
7df0: 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 2836]. fconf
7e00: 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 igure $s3 -buffe
7e10: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f ring line. fo
7e20: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
7e30: 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 < 100} {incr i}
7e40: 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c {..puts $s1 hell
7e50: 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 o,s1..gets $s1..
7e60: 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 puts $s2 hello,s
7e70: 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 2..gets $s2..put
7e80: 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 s $s3 hello,s3..
7e90: 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 gets $s3. }.
7ea0: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
7eb0: 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 close $s2. c
7ec0: 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e lose $s3. sen
7ed0: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
7ee0: 24 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 $socket10_9_test
7ef0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
7f00: 20 69 0a 7d 20 31 30 30 20 20 20 20 0a 74 65 73 i.} 100 .tes
7f10: 74 20 73 6f 63 6b 65 74 2d 31 31 2e 38 20 7b 63 t socket-11.8 {c
7f20: 6c 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 lient with sever
7f30: 61 6c 20 73 65 72 76 65 72 73 7d 20 7b 73 6f 63 al servers} {soc
7f40: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
7f50: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
7f60: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
7f70: 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 ..set s1 [tls::s
7f80: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 61 ocket -server "a
7f90: 63 63 65 70 74 20 34 30 30 33 22 20 34 30 30 33 ccept 4003" 4003
7fa0: 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a ]..set s2 [tls::
7fb0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 22 socket -server "
7fc0: 61 63 63 65 70 74 20 34 30 30 34 22 20 34 30 30 accept 4004" 400
7fd0: 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 6c 73 3a 4]..set s3 [tls:
7fe0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
7ff0: 22 61 63 63 65 70 74 20 34 30 30 35 22 20 34 30 "accept 4005" 40
8000: 30 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 05]..proc accept
8010: 20 7b 6d 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 {mp s a p} {..
8020: 20 20 20 70 75 74 73 20 24 73 20 24 6d 70 0a 09 puts $s $mp..
8030: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
8040: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 }. set s1
8050: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 [tls::socket $r
8060: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 emoteServerIP 40
8070: 30 33 5d 0a 20 20 20 20 73 65 74 20 73 32 20 5b 03]. set s2 [
8080: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d tls::socket $rem
8090: 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 34 oteServerIP 4004
80a0: 5d 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c ]. set s3 [tl
80b0: 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 s::socket $remot
80c0: 65 53 65 72 76 65 72 49 50 20 34 30 30 35 5d 0a eServerIP 4005].
80d0: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
80e0: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 lappend l [gets
80f0: 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 31 5d $s1] [gets $s1]
8100: 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 [eof $s1] [gets
8110: 20 24 73 32 5d 20 5b 67 65 74 73 20 24 73 32 5d $s2] [gets $s2]
8120: 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 [eof $s2] \..[g
8130: 65 74 73 20 24 73 33 5d 20 5b 67 65 74 73 20 24 ets $s3] [gets $
8140: 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 s3] [eof $s3].
8150: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
8160: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
8170: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
8180: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 Command {..close
8190: 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a $s1..close $s2.
81a0: 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 7d .close $s3. }
81b0: 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 . set l.} {40
81c0: 30 33 20 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 03 {} 1 4004 {}
81d0: 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a 74 65 73 1 4005 {} 1}.tes
81e0: 74 20 73 6f 63 6b 65 74 2d 31 31 2e 39 20 7b 61 t socket-11.9 {a
81f0: 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 ccept callback e
8200: 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f rror} {socket do
8210: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8220: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 erver} {. set
8230: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
8240: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
8250: 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 836]. proc ac
8260: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 cept {s a p} {ex
8270: 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 70 pr 10 / 0}. p
8280: 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 roc bgerror args
8290: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
82a0: 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d 0a t x $args. }.
82b0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
82c0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 sendCommand {..
82d0: 20 20 20 73 65 74 20 70 65 65 72 6e 61 6d 65 20 set peername
82e0: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 63 61 6c [fconfigure $cal
82f0: 6c 65 72 53 6f 63 6b 65 74 20 2d 70 65 65 72 6e lerSocket -peern
8300: 61 6d 65 5d 0a 09 20 20 20 20 73 65 74 20 73 20 ame].. set s
8310: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 6c 69 [tls::socket [li
8320: 6e 64 65 78 20 24 70 65 65 72 6e 61 6d 65 20 30 ndex $peername 0
8330: 5d 20 32 38 33 36 5d 0a 09 20 20 20 20 63 6c 6f ] 2836].. clo
8340: 73 65 20 24 73 0a 20 20 20 20 09 20 7d 7d 20 6d se $s. . }} m
8350: 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 73 sg]} {..close $s
8360: 0a 09 65 72 72 6f 72 20 24 6d 73 67 0a 20 20 20 ..error $msg.
8370: 20 7d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 }. set timer
8380: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
8390: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
83a0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
83b0: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
83c0: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
83d0: 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 s. rename bge
83e0: 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 rror {}. set
83f0: 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 x.} {{divide by
8400: 7a 65 72 6f 7d 7d 0a 74 65 73 74 20 73 6f 63 6b zero}}.test sock
8410: 65 74 2d 31 31 2e 31 30 20 7b 74 65 73 74 69 6e et-11.10 {testin
8420: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
8430: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b c options} {sock
8440: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
8450: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
8460: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
8470: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 32 .set socket10_12
8480: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
8490: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
84a0: 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 r accept 2836]..
84b0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
84c0: 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 p} {close $s}.
84d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
84e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d tls::socket $rem
84f0: 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 oteServerIP 2836
8500: 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f ]. set p [fco
8510: 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 nfigure $s -peer
8520: 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 name]. set n
8530: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
8540: 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 sockname]. se
8550: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
8560: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 nd l [lindex $p
8570: 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 2] [llength $p]
8580: 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 [llength $p].
8590: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
85a0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
85b0: 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 $socket10_12_te
85c0: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
85d0: 65 74 20 6c 0a 7d 20 7b 32 38 33 36 20 33 20 33 et l.} {2836 3 3
85e0: 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 }.test socket-11
85f0: 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 .11 {testing spu
8600: 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 rious events} {s
8610: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
8620: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
8630: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8640: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
8650: 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 65 72 20 _13_test_server
8660: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
8670: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
8680: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
8690: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 s a p} {.. fc
86a0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
86b0: 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f 20 6c nslation "auto l
86c0: 66 22 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 f".. after 10
86d0: 30 20 77 72 69 74 65 73 6f 6d 65 20 24 73 0a 09 0 writesome $s..
86e0: 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 73 6f 6d }..proc writesom
86f0: 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 66 6f 72 e {s} {.. for
8700: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
8710: 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 100} {incr i} {
8720: 0a 09 09 70 75 74 73 20 24 73 20 22 6c 69 6e 65 ...puts $s "line
8730: 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f 74 65 20 $i from remote
8740: 73 65 72 76 65 72 22 0a 09 20 20 20 20 7d 0a 09 server".. }..
8750: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a close $s..}.
8760: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 }. set le
8770: 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 n 0. set spur
8780: 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 ious 0. set d
8790: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 one 0. proc r
87a0: 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a eadlittle {s} {.
87b0: 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 .global spurious
87c0: 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c done len..set l
87d0: 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 [read $s 1]..if
87e0: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
87f0: 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 $l] == 0} {..
8800: 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d if {![eof $s]}
8810: 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f {...incr spurio
8820: 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b us.. } else {
8830: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
8840: 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a t done 1.. }.
8850: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 .} else {.. i
8860: 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 ncr len [string
8870: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 length $l]..}.
8880: 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 }. set c [t
8890: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
88a0: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d teServerIP 2836]
88b0: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
88c0: 63 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 c readable "read
88d0: 6c 69 74 74 6c 65 20 24 63 22 0a 20 20 20 20 73 little $c". s
88e0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
88f0: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
8900: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
8910: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
8920: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
8930: 65 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 er. sendComma
8940: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
8950: 74 31 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 t10_13_test_serv
8960: 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 er}. list $sp
8970: 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 urious $len.} {0
8980: 20 32 36 39 30 7d 0a 74 65 73 74 20 73 6f 63 6b 2690}.test sock
8990: 65 74 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e et-11.12 {testin
89a0: 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 g EOF stickyness
89b0: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
89c0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
89d0: 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 75 r} {. set cou
89e0: 6e 74 65 72 20 30 0a 20 20 20 20 73 65 74 20 64 nter 0. set d
89f0: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 63 one 0. proc c
8a00: 6f 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 ount_up {s} {..g
8a10: 6c 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f lobal counter do
8a20: 6e 65 20 61 66 74 65 72 5f 69 64 0a 09 73 65 74 ne after_id..set
8a30: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 l [gets $s]..if
8a40: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
8a50: 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a incr counter.
8a60: 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 . if {$counte
8a70: 72 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 r > 9} {...set d
8a80: 6f 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 69 63 one {EOF is stic
8a90: 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 ky}...after canc
8aa0: 65 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 09 63 el $after_id...c
8ab0: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 lose $s.. }..
8ac0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
8ad0: 20 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a timed_out {} {.
8ae0: 09 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 .global c done..
8af0: 73 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f set done {timed_
8b00: 6f 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 out, EOF is not
8b10: 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 sticky}..close $
8b20: 63 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 c. }. send
8b30: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
8b40: 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f ocket10_14_test_
8b50: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
8b60: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
8b70: 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 pt 2836]..proc a
8b80: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
8b90: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 20 63 . after 100 c
8ba0: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
8bb0: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
8bc0: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
8bd0: 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 erverIP 2836].
8be0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
8bf0: 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 eadable "count_u
8c00: 70 20 24 63 22 0a 20 20 20 20 73 65 74 20 61 66 p $c". set af
8c10: 74 65 72 5f 69 64 20 5b 61 66 74 65 72 20 31 30 ter_id [after 10
8c20: 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 00 timed_out].
8c30: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
8c40: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
8c50: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 ose $socket10_14
8c60: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
8c70: 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f set done.} {EO
8c80: 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 74 65 73 F is sticky}.tes
8c90: 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 33 20 7b t socket-11.13 {
8ca0: 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 testing async wr
8cb0: 69 74 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 ite, async flush
8cc0: 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c , async close} \
8cd0: 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 ..{socket doTest
8ce0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
8cf0: 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 r} {. proc re
8d00: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
8d10: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 al count done..s
8d20: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 et l [read $s]..
8d30: 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 incr count [stri
8d40: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 ng length $l]..i
8d50: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
8d60: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 close $s..
8d70: 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a set done 1..}.
8d80: 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f }. sendCo
8d90: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 69 72 mmand {..set fir
8da0: 73 74 62 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 stblock ""..for
8db0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
8dc0: 35 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 5} {incr i} {...
8dd0: 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 set firstblock "
8de0: 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 66 69 72 a$firstblock$fir
8df0: 73 74 62 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 stblock"..}..set
8e00: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a secondblock "".
8e10: 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b .for {set i 0} {
8e20: 24 69 20 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 $i < 16} {incr i
8e30: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 65 63 } {.. set sec
8e40: 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 65 63 6f ondblock "b$seco
8e50: 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 6c ndblock$secondbl
8e60: 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 6c 20 5b ock"..}..set l [
8e70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
8e80: 76 65 72 20 61 63 63 65 70 74 20 32 38 34 35 5d ver accept 2845]
8e90: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
8ea0: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f a p} {.. fco
8eb0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
8ec0: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 king 0 -translat
8ed0: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 ion lf -buffersi
8ee0: 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 ze 16384 \...-bu
8ef0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 ffering line..
8f00: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
8f10: 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 6c eadable "readabl
8f20: 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 e $s"..}..proc r
8f30: 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 eadable {s} {..
8f40: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
8f50: 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e s].. fileeven
8f60: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d t $s readable {}
8f70: 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 .. after 1000
8f80: 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 respond $s..}..
8f90: 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d proc respond {s}
8fa0: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 {.. global f
8fb0: 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 irstblock.. p
8fc0: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
8fd0: 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 s $firstblock..
8fe0: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 77 72 after 1000 wr
8ff0: 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 itedata $s..}..p
9000: 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 roc writedata {s
9010: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
9020: 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 secondblock..
9030: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
9040: 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b $s $secondblock
9050: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
9060: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
9070: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 s [tls::socket $
9080: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
9090: 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 845]. fconfig
90a0: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
90b0: 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 0 -trans lf -bu
90c0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
90d0: 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 set count 0.
90e0: 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 puts $s hello.
90f0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
9100: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 readable "readit
9110: 20 24 73 22 0a 20 20 20 20 73 65 74 20 74 69 6d $s". set tim
9120: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
9130: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
9140: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
9150: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
9160: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
9170: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
9180: 6f 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 ose $l}. set
9190: 63 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 count.} 65566..t
91a0: 65 73 74 20 73 6f 63 6b 65 74 2d 31 32 2e 31 20 est socket-12.1
91b0: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
91c0: 61 6e 63 65 20 6f 66 20 73 65 72 76 65 72 20 73 ance of server s
91d0: 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b ockets} \..{sock
91e0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
91f0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9200: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
9210: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
9220: 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 ile script2..
9230: 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 # Script1 is ju
9240: 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 st a 10 second d
9250: 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 elay. If the se
9260: 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 rver socket.
9270: 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 # is inherited,
9280: 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 it will be held
9290: 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f open for 10 seco
92a0: 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b nds.. set f [
92b0: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
92c0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
92d0: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
92e0: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
92f0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
9300: 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 f.. # Script2
9310: 20 63 72 65 61 74 65 73 20 74 68 65 20 73 65 72 creates the ser
9320: 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c 61 75 6e ver socket, laun
9330: 63 68 65 73 20 73 63 72 69 70 74 31 2c 0a 20 20 ches script1,.
9340: 20 20 23 20 77 61 69 74 73 20 61 20 73 65 63 6f # waits a seco
9350: 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 2e 20 20 nd, and exits.
9360: 54 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 The server socke
9370: 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 20 23 t will now. #
9380: 20 62 65 20 63 6c 6f 73 65 64 20 75 6e 6c 65 73 be closed unles
9390: 73 20 73 63 72 69 70 74 31 20 69 6e 68 65 72 69 s script1 inheri
93a0: 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 73 65 74 ted it... set
93b0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 f [open script2
93c0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
93d0: 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 74 65 73 [list set tcltes
93e0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
93f0: 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 ltest]. puts
9400: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
9410: 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a 09 73 quire tcltest..s
9420: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
9430: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
9440: 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 2828]..proc acc
9450: 65 70 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 ept { file addr
9460: 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c port } {.. cl
9470: 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 ose $file..}..ex
9480: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
9490: 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 20 26 cltest script1 &
94a0: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 ..close $f..afte
94b0: 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 r 1000 exit..vwa
94c0: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
94d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 09 0a . close $f...
94e0: 20 20 20 20 23 20 4c 61 75 6e 63 68 20 73 63 72 # Launch scr
94f0: 69 70 74 32 20 61 6e 64 20 77 61 69 74 20 35 20 ipt2 and wait 5
9500: 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 65 78 65 seconds.. exe
9510: 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 c $::tcltest::tc
9520: 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a ltest script2 &.
9530: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 7b after 5000 {
9540: 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 set ok_to_proce
9550: 65 64 20 31 20 7d 0a 20 20 20 20 76 77 61 69 74 ed 1 }. vwait
9560: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a ok_to_proceed..
9570: 20 20 20 20 23 20 49 66 20 77 65 20 63 61 6e 20 # If we can
9580: 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f still connect to
9590: 20 74 68 65 20 73 65 72 76 65 72 2c 20 74 68 65 the server, the
95a0: 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 socket got inhe
95b0: 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b rited... if {
95c0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
95d0: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
95e0: 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 28} msg]} {..set
95f0: 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 x {server socke
9600: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
9610: 74 65 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 ted}. } else
9620: 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 73 {..close $msg..s
9630: 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 et x {server soc
9640: 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 ket was inherite
9650: 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 72 65 d}. }.. re
9660: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 moveFile script1
9670: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
9680: 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 script2. set
9690: 78 0a 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 6b x.} {server sock
96a0: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
96b0: 69 74 65 64 7d 0a 74 65 73 74 20 73 6f 63 6b 65 ited}.test socke
96c0: 74 2d 31 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 t-12.2 {testing
96d0: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 63 inheritance of c
96e0: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 73 7d 20 5c lient sockets} \
96f0: 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 ..{socket doTest
9700: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9710: 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 r} {. removeF
9720: 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 ile script1.
9730: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
9740: 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 t2.. # Script
9750: 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 1 is just a 10 s
9760: 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 econd delay. If
9770: 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b the server sock
9780: 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 et. # is inhe
9790: 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 rited, it will b
97a0: 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 e held open for
97b0: 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 10 seconds..
97c0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
97d0: 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt1 w]. puts
97e0: 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 $f {..after 1000
97f0: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
9800: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
9810: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
9820: 53 63 72 69 70 74 32 20 6f 70 65 6e 73 20 74 68 Script2 opens th
9830: 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 e client socket
9840: 61 6e 64 20 77 72 69 74 65 73 20 74 6f 20 69 74 and writes to it
9850: 2e 20 20 49 74 20 74 68 65 6e 0a 20 20 20 20 23 . It then. #
9860: 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 launches script
9870: 31 20 61 6e 64 20 65 78 69 74 73 2e 20 20 49 66 1 and exits. If
9880: 20 74 68 65 20 63 68 69 6c 64 20 70 72 6f 63 65 the child proce
9890: 73 73 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 ss inherited the
98a0: 0a 20 20 20 20 23 20 63 6c 69 65 6e 74 20 73 6f . # client so
98b0: 63 6b 65 74 2c 20 74 68 65 20 73 6f 63 6b 65 74 cket, the socket
98c0: 20 77 69 6c 6c 20 73 74 69 6c 6c 20 62 65 20 6f will still be o
98d0: 70 65 6e 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 pen... set f
98e0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d [open script2 w]
98f0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
9900: 73 74 20 73 65 74 20 74 63 6c 74 65 73 74 20 24 st set tcltest $
9910: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
9920: 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 st]. puts $f
9930: 7b 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 {..set f [tls::s
9940: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
9950: 32 38 32 39 5d 0a 09 65 78 65 63 20 24 3a 3a 74 2829]..exec $::t
9960: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
9970: 73 63 72 69 70 74 31 20 26 0a 09 70 75 74 73 20 script1 &..puts
9980: 24 66 20 74 65 73 74 69 6e 67 0a 09 66 6c 75 73 $f testing..flus
9990: 68 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 h $f..after 1000
99a0: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
99b0: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
99c0: 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 43 lose $f.. # C
99d0: 72 65 61 74 65 20 74 68 65 20 73 65 72 76 65 72 reate the server
99e0: 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 65 74 socket.. set
99f0: 20 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f server [tls::so
9a00: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
9a10: 65 70 74 20 32 38 32 39 5d 0a 20 20 20 20 70 72 ept 2829]. pr
9a20: 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 oc accept { file
9a30: 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 0a host port } {..
9a40: 09 23 20 57 68 65 6e 20 74 68 65 20 63 6c 69 65 .# When the clie
9a50: 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 nt connects, est
9a60: 61 62 6c 69 73 68 20 74 68 65 20 72 65 61 64 20 ablish the read
9a70: 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 handler..global
9a80: 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 server..close $s
9a90: 65 72 76 65 72 0a 09 66 69 6c 65 65 76 65 6e 74 erver..fileevent
9aa0: 20 24 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 $file readable
9ab0: 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 24 66 [list getdata $f
9ac0: 69 6c 65 5d 0a 09 66 63 6f 6e 66 69 67 75 72 65 ile]..fconfigure
9ad0: 20 24 66 69 6c 65 20 2d 62 75 66 66 65 72 69 6e $file -bufferin
9ae0: 67 20 6c 69 6e 65 20 2d 62 6c 6f 63 6b 69 6e 67 g line -blocking
9af0: 20 30 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0..return. }
9b00: 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 61 74 . proc getdat
9b10: 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 a { file } {...#
9b20: 20 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e Read handler on
9b30: 20 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f the accepted so
9b40: 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a cket...global x.
9b50: 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 09 .global failed..
9b60: 73 65 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 set status [catc
9b70: 68 20 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 h {read $file} d
9b80: 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 75 ata]..if {$statu
9b90: 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 s != 0} {.. s
9ba0: 65 74 20 78 20 7b 72 65 61 64 20 66 61 69 6c 65 et x {read faile
9bb0: 64 2c 20 65 72 72 6f 72 20 77 61 73 20 24 64 61 d, error was $da
9bc0: 74 61 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b ta}.. catch {
9bd0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
9be0: 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e } elseif {[strin
9bf0: 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 g compare {} $da
9c00: 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 ta]} {..} elseif
9c10: 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c {[fblocked $fil
9c20: 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 e]} {..} elseif
9c30: 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a {[eof $file]} {.
9c40: 09 20 20 20 20 69 66 20 7b 24 66 61 69 6c 65 64 . if {$failed
9c50: 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 } {...set x {cli
9c60: 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 69 ent socket was i
9c70: 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d nherited}.. }
9c80: 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 20 else {...set x
9c90: 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 {client socket w
9ca0: 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 as not inherited
9cb0: 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 61 }.. }.. ca
9cc0: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
9cd0: 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 e }..} else {..
9ce0: 20 20 20 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 set x {imposs
9cf0: 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 20 20 ible case}..
9d00: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
9d10: 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e ile }..}..return
9d20: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 49 66 . }.. # If
9d30: 20 74 68 65 20 73 6f 63 6b 65 74 20 64 6f 65 73 the socket does
9d40: 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 2d 66 n't hit end-of-f
9d50: 69 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e 64 73 ile in 5 seconds
9d60: 2c 20 74 68 65 0a 20 20 20 20 23 20 73 63 72 69 , the. # scri
9d70: 70 74 31 20 70 72 6f 63 65 73 73 20 6d 75 73 74 pt1 process must
9d80: 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 have inherited
9d90: 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 the client...
9da0: 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 set failed 0.
9db0: 20 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 after 5000 [li
9dc0: 73 74 20 73 65 74 20 66 61 69 6c 65 64 20 31 5d st set failed 1]
9dd0: 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 .. # Launch t
9de0: 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 he script2 proce
9df0: 73 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a ss.. exec $::
9e00: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
9e10: 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 script2 &..
9e20: 76 77 61 69 74 20 78 0a 20 20 20 20 69 66 20 7b vwait x. if {
9e30: 21 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76 77 61 !$failed} {..vwa
9e40: 69 74 20 66 61 69 6c 65 64 0a 20 20 20 20 7d 0a it failed. }.
9e50: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
9e60: 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 cript1. remov
9e70: 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 eFile script2.
9e80: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6c 69 65 6e set x.} {clien
9e90: 74 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 t socket was not
9ea0: 20 69 6e 68 65 72 69 74 65 64 7d 0a 74 65 73 74 inherited}.test
9eb0: 20 73 6f 63 6b 65 74 2d 31 32 2e 33 20 7b 74 65 socket-12.3 {te
9ec0: 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 sting inheritanc
9ed0: 65 20 6f 66 20 61 63 63 65 70 74 65 64 20 73 6f e of accepted so
9ee0: 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 ckets} \..{socke
9ef0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
9f00: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
9f10: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
9f20: 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 pt1. removeFi
9f30: 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 le script2..
9f40: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
9f50: 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt1 w]. puts
9f60: 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 $f {..after 1000
9f70: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
9f80: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
9f90: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 73 65 close $f.. se
9fa0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
9fb0: 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 2 w]. puts $f
9fc0: 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 74 65 [list set tclte
9fd0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
9fe0: 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 cltest]. puts
9ff0: 20 24 66 20 7b 0a 09 73 65 74 20 73 65 72 76 65 $f {..set serve
a000: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
a010: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 39 server accept 29
a020: 33 30 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 30]..proc accept
a030: 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 { file host por
a040: 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 t } {.. globa
a050: 6c 20 74 63 6c 74 65 73 74 0a 09 20 20 20 20 70 l tcltest.. p
a060: 75 74 73 20 24 66 69 6c 65 20 7b 74 65 73 74 20 uts $file {test
a070: 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a data on socket}.
a080: 09 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c . exec $::tcl
a090: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
a0a0: 72 69 70 74 31 20 26 0a 09 20 20 20 20 61 66 74 ript1 &.. aft
a0b0: 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 7d 0a er 1000 exit..}.
a0c0: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
a0d0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
a0e0: 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 f.. # Launch
a0f0: 74 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 the script2 proc
a100: 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 ess and connect
a110: 74 6f 20 69 74 2e 20 20 53 65 65 20 68 6f 77 20 to it. See how
a120: 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 20 73 long. # the s
a130: 6f 63 6b 65 74 20 73 74 61 79 73 20 6f 70 65 6e ocket stays open
a140: 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 .. exec $::tc
a150: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
a160: 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61 66 cript2 &.. af
a170: 74 65 72 20 31 30 30 30 20 73 65 74 20 6f 6b 5f ter 1000 set ok_
a180: 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 20 to_proceed 1.
a190: 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f vwait ok_to_pro
a1a0: 63 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66 20 ceed.. set f
a1b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
a1c0: 2e 30 2e 30 2e 31 20 32 39 33 30 5d 0a 20 20 20 .0.0.1 2930].
a1d0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d fconfigure $f -
a1e0: 62 75 66 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d buffering full -
a1f0: 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 66 blocking 0. f
a200: 69 6c 65 65 76 65 6e 74 20 24 66 20 72 65 61 64 ileevent $f read
a210: 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 able [list getda
a220: 74 61 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 ta $f].. # If
a230: 20 74 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 the socket is s
a240: 74 69 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 till open after
a250: 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 5 seconds, the s
a260: 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 cript1 process.
a270: 20 20 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 # must have i
a280: 6e 68 65 72 69 74 65 64 20 74 68 65 20 61 63 63 nherited the acc
a290: 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 epted socket...
a2a0: 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a set failed 0.
a2b0: 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 73 after 5000 s
a2c0: 65 74 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 et failed 1..
a2d0: 20 70 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 proc getdata {
a2e0: 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 file } {...# Rea
a2f0: 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 d handler on the
a300: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2e 0a client socket..
a310: 09 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 .global x..globa
a320: 6c 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 l failed..set st
a330: 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 atus [catch {rea
a340: 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 d $file} data]..
a350: 69 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 if {$status != 0
a360: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b } {.. set x {
a370: 72 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 read failed, err
a380: 6f 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 or was $data}..
a390: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
a3a0: 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 $file }..} else
a3b0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
a3c0: 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b are {} $data]} {
a3d0: 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c ..} elseif {[fbl
a3e0: 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a ocked $file]} {.
a3f0: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 .} elseif {[eof
a400: 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 $file]} {.. i
a410: 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 f {$failed} {...
a420: 73 65 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 set x {accepted
a430: 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 socket was inher
a440: 69 74 65 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 ited}.. } els
a450: 65 20 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 63 e {...set x {acc
a460: 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 epted socket was
a470: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
a480: 09 20 20 20 20 7d 0a 09 20 20 20 20 63 61 74 63 . }.. catc
a490: 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 h { close $file
a4a0: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 }..} else {..
a4b0: 20 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 set x {impossib
a4c0: 6c 65 20 63 61 73 65 7d 0a 09 20 20 20 20 63 61 le case}.. ca
a4d0: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
a4e0: 65 20 7d 0a 09 7d 0a 09 72 65 74 75 72 6e 0a 20 e }..}..return.
a4f0: 20 20 20 7d 0a 20 20 20 20 0a 20 20 20 20 76 77 }. . vw
a500: 61 69 74 20 78 0a 0a 20 20 20 20 72 65 6d 6f 76 ait x.. remov
a510: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
a520: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
a530: 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a 7d ipt2. set x.}
a540: 20 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 {accepted socke
a550: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
a560: 74 65 64 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 ted}..test socke
a570: 74 2d 31 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 t-13.1 {Testing
a580: 75 73 65 20 6f 66 20 73 68 61 72 65 64 20 73 6f use of shared so
a590: 63 6b 65 74 20 62 65 74 77 65 65 6e 20 74 77 6f cket between two
a5a0: 20 74 68 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f threads} \..{so
a5b0: 63 6b 65 74 20 74 65 73 74 74 68 72 65 61 64 7d cket testthread}
a5c0: 20 7b 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 {.. removeFi
a5d0: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 74 68 le script. th
a5e0: 72 65 61 64 52 65 61 70 0a 0a 20 20 20 20 6d 61 readReap.. ma
a5f0: 6b 65 46 69 6c 65 20 7b 0a 20 20 20 20 09 70 61 keFile {. .pa
a600: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
a610: 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 s..set f [tls::s
a620: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
a630: 63 65 70 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 cept 2828]..proc
a640: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
a650: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 {. fi
a660: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
a670: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
a680: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 s]. f
a690: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
a6a0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
a6b0: 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 }..proc ech
a6c0: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c o {s} {.. gl
a6d0: 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 obal i.
a6e0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
a6f0: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
a700: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
a710: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a720: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
a730: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
a740: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
a750: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
a760: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 . }
a770: 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 else { ..
a780: 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 incr i.
a790: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
a7a0: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
a7b0: 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a }..}..set i 0.
a7c0: 09 76 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 .vwait x..close
a7d0: 24 66 0a 0a 09 23 20 74 68 72 65 61 64 20 63 6c $f...# thread cl
a7e0: 65 61 6e 73 20 69 74 73 65 6c 66 20 75 70 2e 0a eans itself up..
a7f0: 09 74 65 73 74 74 68 72 65 61 64 20 65 78 69 74 .testthread exit
a800: 0a 20 20 20 20 7d 20 73 63 72 69 70 74 0a 20 20 . } script.
a810: 20 20 0a 20 20 20 20 23 20 63 72 65 61 74 65 20 . # create
a820: 61 20 74 68 72 65 61 64 0a 20 20 20 20 73 65 74 a thread. set
a830: 20 73 65 72 76 65 72 74 68 72 65 61 64 20 5b 74 serverthread [t
a840: 65 73 74 74 68 72 65 61 64 20 63 72 65 61 74 65 estthread create
a850: 20 7b 20 73 6f 75 72 63 65 20 73 63 72 69 70 74 { source script
a860: 20 7d 20 5d 0a 20 20 20 20 75 70 64 61 74 65 0a } ]. update.
a870: 20 20 20 20 0a 20 20 20 20 61 66 74 65 72 20 31 . after 1
a880: 30 30 30 0a 20 20 20 20 73 65 74 20 73 20 5b 74 000. set s [t
a890: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
a8a0: 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 66 .0.1 2828]. f
a8b0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
a8c0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 ffering line..
a8d0: 20 20 63 61 74 63 68 20 7b 0a 09 70 75 74 73 20 catch {..puts
a8e0: 24 73 20 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 $s "hello"..gets
a8f0: 20 24 73 20 72 65 73 75 6c 74 0a 20 20 20 20 7d $s result. }
a900: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
a910: 20 20 75 70 64 61 74 65 0a 0a 20 20 20 20 61 66 update.. af
a920: 74 65 72 20 32 30 30 30 0a 20 20 20 20 6c 61 70 ter 2000. lap
a930: 70 65 6e 64 20 72 65 73 75 6c 74 20 5b 74 68 72 pend result [thr
a940: 65 61 64 52 65 61 70 5d 0a 20 20 20 20 0a 20 20 eadReap]. .
a950: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 set result..}
a960: 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c 65 {hello 1}..# cle
a970: 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 anup.if {[string
a980: 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f match sock* $co
a990: 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 mmandSocket] ==
a9a0: 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 1} {. puts $co
a9b0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 mmandSocket exit
a9c0: 0a 20 20 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 . flush $comma
a9d0: 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 ndSocket.}.catch
a9e0: 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 {close $command
a9f0: 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 Socket}.catch {c
aa00: 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 lose $remoteProc
aa10: 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a Chan}.::tcltest:
aa20: 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 0a 66 6c :cleanupTests.fl
aa30: 75 73 68 20 73 74 64 6f 75 74 0a 72 65 74 75 72 ush stdout.retur
aa40: 6e 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a n............