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 33 20 32 30 30 30 2f test,v 1.3 2000/
0210: 30 36 2f 30 32 20 32 30 3a 34 35 3a 33 38 20 61 06/02 20:45:38 a
0220: 77 62 20 45 78 70 20 24 0a 0a 23 20 52 75 6e 6e wb Exp $..# Runn
0230: 69 6e 67 20 73 6f 63 6b 65 74 20 74 65 73 74 73 ing socket tests
0240: 20 77 69 74 68 20 61 20 72 65 6d 6f 74 65 20 73 with a remote s
0250: 65 72 76 65 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d erver:.# -------
0260: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0270: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0280: 2d 2d 2d 0a 23 20 0a 23 20 53 6f 6d 65 20 74 65 ---.# .# Some te
0290: 73 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 65 sts in socket.te
02a0: 73 74 20 64 65 70 65 6e 64 20 6f 6e 20 74 68 65 st depend on the
02b0: 20 65 78 69 73 74 65 6e 63 65 20 6f 66 20 61 20 existence of a
02c0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 74 6f remote server to
02d0: 0a 23 20 77 68 69 63 68 20 74 68 65 79 20 63 6f .# which they co
02e0: 6e 6e 65 63 74 2e 20 54 68 65 20 72 65 6d 6f 74 nnect. The remot
02f0: 65 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 e server must be
0300: 20 61 6e 20 69 6e 73 74 61 6e 63 65 20 6f 66 20 an instance of
0310: 74 63 6c 74 65 73 74 20 61 6e 64 20 69 74 0a 23 tcltest and it.#
0320: 20 6d 75 73 74 20 72 75 6e 20 74 68 65 20 73 63 must run the sc
0330: 72 69 70 74 20 66 6f 75 6e 64 20 69 6e 20 74 68 ript found in th
0340: 65 20 66 69 6c 65 20 22 72 65 6d 6f 74 65 2e 74 e file "remote.t
0350: 63 6c 22 20 69 6e 20 74 68 69 73 20 64 69 72 65 cl" in this dire
0360: 63 74 6f 72 79 2e 20 59 6f 75 0a 23 20 63 61 6e ctory. You.# can
0370: 20 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 start the remot
0380: 65 20 73 65 72 76 65 72 20 6f 6e 20 61 6e 79 20 e server on any
0390: 6d 61 63 68 69 6e 65 20 72 65 61 63 68 61 62 6c machine reachabl
03a0: 65 20 66 72 6f 6d 20 74 68 65 20 6d 61 63 68 69 e from the machi
03b0: 6e 65 20 6f 6e 0a 23 20 77 68 69 63 68 20 79 6f ne on.# which yo
03c0: 75 20 77 61 6e 74 20 74 6f 20 72 75 6e 20 74 68 u want to run th
03d0: 65 20 73 6f 63 6b 65 74 20 74 65 73 74 73 2c 20 e socket tests,
03e0: 62 79 20 69 73 73 75 69 6e 67 3a 0a 23 20 0a 23 by issuing:.# .#
03f0: 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d tcltest rem
0400: 6f 74 65 2e 74 63 6c 20 2d 70 6f 72 74 20 32 30 ote.tcl -port 20
0410: 34 38 09 23 20 4f 72 20 63 68 6f 6f 73 65 20 61 48.# Or choose a
0420: 6e 6f 74 68 65 72 20 70 6f 72 74 20 6e 75 6d 62 nother port numb
0430: 65 72 2e 0a 23 20 0a 23 20 49 66 20 74 68 65 20 er..# .# If the
0440: 6d 61 63 68 69 6e 65 20 79 6f 75 20 61 72 65 20 machine you are
0450: 72 75 6e 6e 69 6e 67 20 74 68 65 20 72 65 6d 6f running the remo
0460: 74 65 20 73 65 72 76 65 72 20 6f 6e 20 68 61 73 te server on has
0470: 20 73 65 76 65 72 61 6c 20 49 50 0a 23 20 69 6e several IP.# in
0480: 74 65 72 66 61 63 65 73 2c 20 79 6f 75 20 63 61 terfaces, you ca
0490: 6e 20 63 68 6f 6f 73 65 20 77 68 69 63 68 20 69 n choose which i
04a0: 6e 74 65 72 66 61 63 65 20 74 68 65 20 73 65 72 nterface the ser
04b0: 76 65 72 20 6c 69 73 74 65 6e 73 20 6f 6e 20 66 ver listens on f
04c0: 6f 72 0a 23 20 63 6f 6e 6e 65 63 74 69 6f 6e 73 or.# connections
04d0: 20 62 79 20 73 70 65 63 69 66 79 69 6e 67 20 74 by specifying t
04e0: 68 65 20 2d 61 64 64 72 65 73 73 20 63 6f 6d 6d he -address comm
04f0: 61 6e 64 20 6c 69 6e 65 20 66 6c 61 67 2c 20 73 and line flag, s
0500: 6f 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 o:.# .# tclt
0510: 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d est remote.tcl -
0520: 61 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 address your.mac
0530: 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 54 68 hine.com.# .# Th
0540: 65 73 65 20 6f 70 74 69 6f 6e 73 20 63 61 6e 20 ese options can
0550: 61 6c 73 6f 20 62 65 20 73 65 74 20 62 79 20 65 also be set by e
0560: 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 nvironment varia
0570: 62 6c 65 73 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 bles. On Unix, y
0580: 6f 75 20 63 61 6e 0a 23 20 74 79 70 65 20 74 68 ou can.# type th
0590: 65 73 65 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 ese commands to
05a0: 74 68 65 20 73 68 65 6c 6c 20 66 72 6f 6d 20 77 the shell from w
05b0: 68 69 63 68 20 74 68 65 20 72 65 6d 6f 74 65 20 hich the remote
05c0: 73 65 72 76 65 72 20 69 73 20 73 74 61 72 74 65 server is starte
05d0: 64 3a 0a 23 20 0a 23 20 20 20 20 20 73 68 65 6c d:.# .# shel
05e0: 6c 25 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 l% setenv server
05f0: 50 6f 72 74 20 32 30 34 38 0a 23 20 20 20 20 20 Port 2048.#
0600: 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 73 65 shell% setenv se
0610: 72 76 65 72 41 64 64 72 65 73 73 20 79 6f 75 72 rverAddress your
0620: 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 20 0a .machine.com.# .
0630: 23 20 61 6e 64 20 73 75 62 73 65 71 75 65 6e 74 # and subsequent
0640: 6c 79 20 79 6f 75 20 63 61 6e 20 73 74 61 72 74 ly you can start
0650: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
0660: 65 72 20 77 69 74 68 3a 0a 23 20 0a 23 20 20 20 er with:.# .#
0670: 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 tcltest remote
0680: 2e 74 63 6c 0a 23 20 0a 23 20 74 6f 20 68 61 76 .tcl.# .# to hav
0690: 65 20 69 74 20 6c 69 73 74 65 6e 20 6f 6e 20 70 e it listen on p
06a0: 6f 72 74 20 32 30 34 38 20 6f 6e 20 74 68 65 20 ort 2048 on the
06b0: 69 6e 74 65 72 66 61 63 65 20 79 6f 75 72 2e 6d interface your.m
06c0: 61 63 68 69 6e 65 2e 63 6f 6d 2e 0a 23 20 20 20 achine.com..#
06d0: 20 20 0a 23 20 57 68 65 6e 20 74 68 65 20 73 65 .# When the se
06e0: 72 76 65 72 20 73 74 61 72 74 73 2c 20 69 74 20 rver starts, it
06f0: 70 72 69 6e 74 73 20 6f 75 74 20 61 20 64 65 74 prints out a det
0700: 61 69 6c 65 64 20 6d 65 73 73 61 67 65 20 63 6f ailed message co
0710: 6e 74 61 69 6e 69 6e 67 20 69 74 73 0a 23 20 63 ntaining its.# c
0720: 6f 6e 66 69 67 75 72 61 74 69 6f 6e 20 69 6e 66 onfiguration inf
0730: 6f 72 6d 61 74 69 6f 6e 2c 20 61 6e 64 20 69 74 ormation, and it
0740: 20 77 69 6c 6c 20 62 6c 6f 63 6b 20 75 6e 74 69 will block unti
0750: 6c 20 6b 69 6c 6c 65 64 20 77 69 74 68 20 61 20 l killed with a
0760: 43 74 72 6c 2d 43 2e 0a 23 20 4f 6e 63 65 20 74 Ctrl-C..# Once t
0770: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
0780: 20 65 78 69 73 74 73 2c 20 79 6f 75 20 63 61 6e exists, you can
0790: 20 72 75 6e 20 74 68 65 20 74 65 73 74 73 20 69 run the tests i
07a0: 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 77 69 n socket.test wi
07b0: 74 68 0a 23 20 74 68 65 20 73 65 72 76 65 72 20 th.# the server
07c0: 62 79 20 73 65 74 74 69 6e 67 20 74 77 6f 20 54 by setting two T
07d0: 63 6c 20 76 61 72 69 61 62 6c 65 73 3a 0a 23 20 cl variables:.#
07e0: 0a 23 20 20 20 20 20 25 20 73 65 74 20 72 65 6d .# % set rem
07f0: 6f 74 65 53 65 72 76 65 72 49 50 20 3c 6e 61 6d oteServerIP <nam
0800: 65 20 6f 72 20 61 64 64 72 65 73 73 20 6f 66 20 e or address of
0810: 6d 61 63 68 69 6e 65 20 6f 6e 20 77 68 69 63 68 machine on which
0820: 20 73 65 72 76 65 72 20 72 75 6e 73 3e 0a 23 20 server runs>.#
0830: 20 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 % set remote
0840: 53 65 72 76 65 72 50 6f 72 74 20 32 30 34 38 0a ServerPort 2048.
0850: 23 20 0a 23 20 54 68 65 73 65 20 76 61 72 69 61 # .# These varia
0860: 62 6c 65 73 20 61 72 65 20 61 6c 73 6f 20 73 65 bles are also se
0870: 74 74 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 20 ttable from the
0880: 65 6e 76 69 72 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 environment. On
0890: 55 6e 69 78 2c 20 79 6f 75 20 63 61 6e 3a 0a 23 Unix, you can:.#
08a0: 20 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 .# shell% s
08b0: 65 74 65 6e 76 20 72 65 6d 6f 74 65 53 65 72 76 etenv remoteServ
08c0: 65 72 49 50 20 6d 61 63 68 69 6e 65 2e 77 68 65 erIP machine.whe
08d0: 72 65 2e 73 65 72 76 65 72 2e 72 75 6e 73 0a 23 re.server.runs.#
08e0: 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 6e 65 shell% sene
08f0: 74 76 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 tv remoteServerP
0900: 6f 72 74 20 32 30 34 38 0a 23 20 0a 23 20 54 68 ort 2048.# .# Th
0910: 65 20 70 72 65 61 6d 62 6c 65 20 6f 66 20 74 68 e preamble of th
0920: 65 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 69 e socket.test fi
0930: 6c 65 20 63 68 65 63 6b 73 20 74 6f 20 73 65 65 le checks to see
0940: 20 69 66 20 74 68 65 20 76 61 72 69 61 62 6c 65 if the variable
0950: 73 20 61 72 65 20 73 65 74 0a 23 20 65 69 74 68 s are set.# eith
0960: 65 72 20 69 6e 20 54 63 6c 20 6f 72 20 69 6e 20 er in Tcl or in
0970: 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 3b the environment;
0980: 20 69 66 20 74 68 65 79 20 61 72 65 2c 20 69 74 if they are, it
0990: 20 61 74 74 65 6d 70 74 73 20 74 6f 20 63 6f 6e attempts to con
09a0: 6e 65 63 74 20 74 6f 0a 23 20 74 68 65 20 73 65 nect to.# the se
09b0: 72 76 65 72 2e 20 49 66 20 74 68 65 20 63 6f 6e rver. If the con
09c0: 6e 65 63 74 69 6f 6e 20 69 73 20 73 75 63 63 65 nection is succe
09d0: 73 73 66 75 6c 2c 20 74 68 65 20 74 65 73 74 73 ssful, the tests
09e0: 20 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 using the remot
09f0: 65 0a 23 20 73 65 72 76 65 72 20 77 69 6c 6c 20 e.# server will
0a00: 62 65 20 70 65 72 66 6f 72 6d 65 64 3b 20 6f 74 be performed; ot
0a10: 68 65 72 77 69 73 65 2c 20 69 74 20 77 69 6c 6c herwise, it will
0a20: 20 61 74 74 65 6d 70 74 20 74 6f 20 73 74 61 72 attempt to star
0a30: 74 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 t the remote.# s
0a40: 65 72 76 65 72 20 28 76 69 61 20 65 78 65 63 29 erver (via exec)
0a50: 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 on platforms th
0a60: 61 74 20 73 75 70 70 6f 72 74 20 74 68 69 73 2c at support this,
0a70: 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 68 6f on the local ho
0a80: 73 74 2c 0a 23 20 6c 69 73 74 65 6e 69 6e 67 20 st,.# listening
0a90: 61 74 20 70 6f 72 74 20 32 30 34 38 2e 20 49 66 at port 2048. If
0aa0: 20 61 6c 6c 20 66 61 69 6c 73 2c 20 61 20 6d 65 all fails, a me
0ab0: 73 73 61 67 65 20 69 73 20 70 72 69 6e 74 65 64 ssage is printed
0ac0: 20 61 6e 64 20 74 68 65 20 74 65 73 74 73 0a 23 and the tests.#
0ad0: 20 75 73 69 6e 67 20 74 68 65 20 72 65 6d 6f 74 using the remot
0ae0: 65 20 73 65 72 76 65 72 20 61 72 65 20 6e 6f 74 e server are not
0af0: 20 70 65 72 66 6f 72 6d 65 64 2e 0a 0a 69 66 20 performed...if
0b00: 7b 5b 6c 73 65 61 72 63 68 20 5b 6e 61 6d 65 73 {[lsearch [names
0b10: 70 61 63 65 20 63 68 69 6c 64 72 65 6e 5d 20 3a pace children] :
0b20: 3a 74 63 6c 74 65 73 74 5d 20 3d 3d 20 2d 31 7d :tcltest] == -1}
0b30: 20 7b 0a 20 20 20 20 70 61 63 6b 61 67 65 20 72 {. package r
0b40: 65 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a 20 equire tcltest.
0b50: 20 20 20 6e 61 6d 65 73 70 61 63 65 20 69 6d 70 namespace imp
0b60: 6f 72 74 20 2d 66 6f 72 63 65 20 3a 3a 74 63 6c ort -force ::tcl
0b70: 74 65 73 74 3a 3a 2a 0a 7d 0a 0a 23 20 4c 6f 61 test::*.}..# Loa
0b80: 64 20 74 68 65 20 74 6c 73 20 70 61 63 6b 61 67 d the tls packag
0b90: 65 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 e.package requir
0ba0: 65 20 74 6c 73 0a 0a 23 20 53 6f 6d 65 20 74 65 e tls..# Some te
0bb0: 73 74 73 20 72 65 71 75 69 72 65 20 74 68 65 20 sts require the
0bc0: 74 65 73 74 74 68 72 65 61 64 20 63 6f 6d 6d 61 testthread comma
0bd0: 6e 64 0a 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 nd..set ::tcltes
0be0: 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e t::testConstrain
0bf0: 74 73 28 74 65 73 74 74 68 72 65 61 64 29 20 5c ts(testthread) \
0c00: 0a 09 5b 65 78 70 72 20 7b 5b 69 6e 66 6f 20 63 ..[expr {[info c
0c10: 6f 6d 6d 61 6e 64 73 20 74 65 73 74 74 68 72 65 ommands testthre
0c20: 61 64 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a 23 ad] != {}}]..#.#
0c30: 20 49 66 20 72 65 6d 6f 74 65 53 65 72 76 65 72 If remoteServer
0c40: 49 50 20 6f 72 20 72 65 6d 6f 74 65 53 65 72 76 IP or remoteServ
0c50: 65 72 50 6f 72 74 20 61 72 65 20 6e 6f 74 20 73 erPort are not s
0c60: 65 74 2c 20 63 68 65 63 6b 20 69 6e 20 74 68 65 et, check in the
0c70: 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 .# environment v
0c80: 61 72 69 61 62 6c 65 73 20 66 6f 72 20 65 78 74 ariables for ext
0c90: 65 72 6e 61 6c 6c 79 20 73 65 74 20 76 61 6c 75 ernally set valu
0ca0: 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e 66 es..#..if {![inf
0cb0: 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 o exists remoteS
0cc0: 65 72 76 65 72 49 50 5d 7d 20 7b 0a 20 20 20 20 erverIP]} {.
0cd0: 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 if {[info exists
0ce0: 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 env(remoteServe
0cf0: 72 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 rIP)]} {..set re
0d00: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 65 6e moteServerIP $en
0d10: 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 v(remoteServerIP
0d20: 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b ). }.}.if {![
0d30: 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f info exists remo
0d40: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b teServerPort]} {
0d50: 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 . if {[info e
0d60: 78 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 xists env(remote
0d70: 53 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 ServerIP)]} {..s
0d80: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 et remoteServerP
0d90: 6f 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 ort $env(remoteS
0da0: 65 72 76 65 72 50 6f 72 74 29 0a 20 20 20 20 7d erverPort). }
0db0: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
0dc0: 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 if {[info exists
0dd0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d remoteServerIP]
0de0: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d } {.. set rem
0df0: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 32 30 oteServerPort 20
0e00: 34 38 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 48. }.
0e10: 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 6b 20 }.}..#.# Check
0e20: 69 66 20 77 65 27 72 65 20 73 75 70 70 6f 73 65 if we're suppose
0e30: 64 20 74 6f 20 64 6f 20 74 65 73 74 73 20 61 67 d to do tests ag
0e40: 61 69 6e 73 74 20 74 68 65 20 72 65 6d 6f 74 65 ainst the remote
0e50: 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 20 64 server.#..set d
0e60: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
0e70: 53 65 72 76 65 72 20 31 0a 69 66 20 7b 21 5b 69 Server 1.if {![i
0e80: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 nfo exists remot
0e90: 65 53 65 72 76 65 72 49 50 5d 20 26 26 20 28 24 eServerIP] && ($
0ea0: 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 tcl_platform(pla
0eb0: 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 69 6e tform) != "macin
0ec0: 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 73 65 tosh")} {. se
0ed0: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 t remoteServerIP
0ee0: 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 66 20 127.0.0.1.}.if
0ef0: 7b 28 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 {($doTestsWithRe
0f00: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 29 moteServer == 1)
0f10: 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 69 73 && (![info exis
0f20: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 ts remoteServerP
0f30: 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 65 74 ort])} {. set
0f40: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 remoteServerPor
0f50: 74 20 32 30 34 38 0a 7d 0a 0a 23 20 41 74 74 65 t 2048.}..# Atte
0f60: 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 mpt to connect t
0f70: 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 o a remote serve
0f80: 72 20 69 66 20 6f 6e 65 20 69 73 20 61 6c 72 65 r if one is alre
0f90: 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 66 20 ady running. If
0fa0: 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 6e 6e it.# is not runn
0fb0: 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d 65 20 ing or for some
0fc0: 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 74 68 65 other reason the
0fd0: 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 2c 20 connect fails,
0fe0: 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 74 61 attempt to.# sta
0ff0: 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 rt the remote se
1000: 72 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f 63 61 rver on the loca
1010: 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 6e 67 l host listening
1020: 20 6f 6e 20 70 6f 72 74 20 32 30 34 38 2e 20 54 on port 2048. T
1030: 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 64 6f his.# is only do
1040: 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 ne on platforms
1050: 74 68 61 74 20 73 75 70 70 6f 72 74 20 65 78 65 that support exe
1060: 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 c (i.e. not on t
1070: 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 70 6c he Mac). On.# pl
1080: 61 74 66 6f 72 6d 73 20 74 68 61 74 20 64 6f 20 atforms that do
1090: 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 not support exec
10a0: 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 , the remote ser
10b0: 76 65 72 20 6d 75 73 74 20 62 65 20 73 74 61 72 ver must be star
10c0: 74 65 64 0a 23 20 62 79 20 74 68 65 20 75 73 65 ted.# by the use
10d0: 72 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 r before running
10e0: 20 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 65 74 the tests...set
10f0: 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 remoteProcChan
1100: 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f "".set commandSo
1110: 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 6f 54 cket "".if {$doT
1120: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1130: 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 74 63 rver} {. catc
1140: 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e h {close $comman
1150: 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 66 20 dSocket}. if
1160: 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d {[catch {set com
1170: 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a mandSocket [tls:
1180: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
1190: 65 72 76 65 72 49 50 20 5c 0a 09 09 09 09 09 09 erverIP \.......
11a0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 $remoteServerPor
11b0: 74 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 69 66 t]}] != 0} {..if
11c0: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 {[info commands
11d0: 20 65 78 65 63 5d 20 3d 3d 20 22 22 7d 20 7b 0a exec] == ""} {.
11e0: 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f 74 . set noRemot
11f0: 65 54 65 73 74 52 65 61 73 6f 6e 20 22 63 61 6e eTestReason "can
1200: 27 74 20 65 78 65 63 22 0a 09 20 20 20 20 73 65 't exec".. se
1210: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
1220: 6f 74 65 53 65 72 76 65 72 20 30 0a 09 7d 20 65 oteServer 0..} e
1230: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 72 lse {.. set r
1240: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 emoteServerIP 12
1250: 37 2e 30 2e 30 2e 31 0a 09 20 20 20 20 73 65 74 7.0.0.1.. set
1260: 20 72 65 6d 6f 74 65 46 69 6c 65 20 5b 66 69 6c remoteFile [fil
1270: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 65 6d e join [pwd] rem
1280: 6f 74 65 2e 74 63 6c 5d 0a 09 20 20 20 20 69 66 ote.tcl].. if
1290: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 72 65 {[catch {set re
12a0: 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 5c 0a 09 moteProcChan \..
12b0: 09 09 09 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 ...[open "|[list
12c0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
12d0: 74 65 73 74 20 24 72 65 6d 6f 74 65 46 69 6c 65 test $remoteFile
12e0: 20 5c 0a 09 09 09 09 09 2d 73 65 72 76 65 72 49 \......-serverI
12f0: 73 53 69 6c 65 6e 74 20 5c 0a 09 09 09 09 09 2d sSilent \......-
1300: 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 port $remoteServ
1310: 65 72 50 6f 72 74 20 5c 0a 09 09 09 09 09 2d 61 erPort \......-a
1320: 64 64 72 65 73 73 20 24 72 65 6d 6f 74 65 53 65 ddress $remoteSe
1330: 72 76 65 72 49 50 5d 22 20 5c 0a 09 09 09 09 09 rverIP]" \......
1340: 77 2b 5d 7d 20 5c 0a 09 09 20 20 20 6d 73 67 5d w+]} \... msg]
1350: 20 3d 3d 20 30 7d 20 7b 0a 09 09 61 66 74 65 72 == 0} {...after
1360: 20 31 30 30 30 0a 09 09 69 66 20 7b 5b 63 61 74 1000...if {[cat
1370: 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 ch {set commandS
1380: 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b ocket [tls::sock
1390: 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 et $remoteServer
13a0: 49 50 20 5c 0a 09 09 09 09 24 72 65 6d 6f 74 65 IP \.....$remote
13b0: 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 ServerPort]} msg
13c0: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 ] == 0} {...
13d0: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d fconfigure $comm
13e0: 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 andSocket -trans
13f0: 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 lation crlf -buf
1400: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 7d 20 fering line...}
1410: 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 65 74 else {... set
1420: 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 noRemoteTestRea
1430: 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 20 73 son $msg... s
1440: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
1450: 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 09 7d moteServer 0...}
1460: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
1470: 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 .set noRemoteTes
1480: 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 24 3a tReason "$msg $:
1490: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
14a0: 74 22 0a 09 09 73 65 74 20 64 6f 54 65 73 74 73 t"...set doTests
14b0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
14c0: 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 0.. }..}.
14d0: 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f 6e 66 } else {..fconf
14e0: 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f igure $commandSo
14f0: 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f cket -translatio
1500: 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e n crlf -bufferin
1510: 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d 0a 0a g line. }.}..
1520: 23 20 53 6f 6d 65 20 74 65 73 74 73 20 61 72 65 # Some tests are
1530: 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 65 20 run only if we
1540: 61 72 65 20 64 6f 69 6e 67 20 74 65 73 74 69 6e are doing testin
1550: 67 20 61 67 61 69 6e 73 74 20 61 20 72 65 6d 6f g against a remo
1560: 74 65 20 73 65 72 76 65 72 2e 0a 73 65 74 20 3a te server..set :
1570: 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f :tcltest::testCo
1580: 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 65 73 74 nstraints(doTest
1590: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
15a0: 72 29 20 24 64 6f 54 65 73 74 73 57 69 74 68 52 r) $doTestsWithR
15b0: 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 20 7b emoteServer.if {
15c0: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
15d0: 74 65 53 65 72 76 65 72 20 3d 3d 20 30 7d 20 7b teServer == 0} {
15e0: 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 . if {[string
15f0: 20 66 69 72 73 74 20 73 20 24 3a 3a 74 63 6c 74 first s $::tclt
1600: 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 21 3d est::verbose] !=
1610: 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 74 73 -1} {. .puts
1620: 20 22 53 6b 69 70 70 69 6e 67 20 74 65 73 74 73 "Skipping tests
1630: 20 77 69 74 68 20 72 65 6d 6f 74 65 20 73 65 72 with remote ser
1640: 76 65 72 2e 20 53 65 65 20 74 65 73 74 73 2f 73 ver. See tests/s
1650: 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 22 0a ocket.test for".
1660: 09 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 74 69 .puts "informati
1670: 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 75 6e on on how to run
1680: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 22 remote server."
1690: 0a 09 70 75 74 73 20 22 52 65 61 73 6f 6e 20 66 ..puts "Reason f
16a0: 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 65 6d or not doing rem
16b0: 6f 74 65 20 74 65 73 74 73 3a 20 24 6e 6f 52 65 ote tests: $noRe
16c0: 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 22 0a moteTestReason".
16d0: 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 }.}..#.# If
16e0: 77 65 20 64 6f 20 74 68 65 20 74 65 73 74 73 2c we do the tests,
16f0: 20 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d 61 6e define a comman
1700: 64 20 74 6f 20 73 65 6e 64 20 61 20 63 6f 6d 6d d to send a comm
1710: 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 65 6d and to the.# rem
1720: 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 0a 0a 69 ote server..#..i
1730: 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 f {$doTestsWithR
1740: 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 emoteServer == 1
1750: 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 65 6e } {. proc sen
1760: 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 dCommand {c} {..
1770: 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f global commandSo
1780: 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 cket...if {[eof
1790: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d $commandSocket]}
17a0: 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 {.. error "r
17b0: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 emote server dis
17c0: 61 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a 09 69 appeared"..}...i
17d0: 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 f {[catch {puts
17e0: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 24 $commandSocket $
17f0: 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 c} msg]} {..
1800: 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 error "remote se
1810: 72 76 65 72 20 64 69 73 61 70 70 61 65 72 65 64 rver disappaered
1820: 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 20 7b : $msg"..}..if {
1830: 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f [catch {puts $co
1840: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d 2d 4d mmandSocket "--M
1850: 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d arker--Marker--M
1860: 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 arker--"} msg]}
1870: 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 {.. error "re
1880: 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 mote server disa
1890: 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 ppeared: $msg"..
18a0: 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 22 22 0a }...set resp "".
18b0: 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 .while {1} {..
18c0: 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 74 73 set line [gets
18d0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
18e0: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
18f0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 commandSocket]}
1900: 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 6d 6f 74 {...error "remot
1910: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 61 e server disappa
1920: 65 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 20 20 ered".. }..
1930: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f if {[string co
1940: 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 2d 2d 4d mpare $line "--M
1950: 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d arker--Marker--M
1960: 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 arker--"] == 0}
1970: 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 {...if {[string
1980: 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 compare [lindex
1990: 24 72 65 73 70 20 30 5d 20 65 72 72 6f 72 5d 20 $resp 0] error]
19a0: 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 65 72 == 0} {... er
19b0: 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 ror [lindex $res
19c0: 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a p 1]...} else {.
19d0: 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 .. return [li
19e0: 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 ndex $resp 1]...
19f0: 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a }.. } else {.
1a00: 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 24 6c ..append resp $l
1a10: 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a ine "\n".. }.
1a20: 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 73 74 .}. }.}..test
1a30: 20 73 6f 63 6b 65 74 2d 31 2e 31 20 7b 61 72 67 socket-1.1 {arg
1a40: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
1a50: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
1a60: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
1a70: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
1a80: 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d 73 cket -server} ms
1a90: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
1aa0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
1ab0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
1ac0: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
1ad0: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
1ae0: 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 t"}}..test socke
1af0: 74 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 69 t-1.2 {arg parsi
1b00: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1b10: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1b20: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1b30: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1b40: 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d server foo} msg]
1b50: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
1b60: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
1b70: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
1b80: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
1b90: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
1ba0: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
1bb0: 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.3 {arg parsing
1bc0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
1bd0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
1be0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
1bf0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
1c00: 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a addr} msg] $msg.
1c10: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
1c20: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
1c30: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
1c40: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
1c50: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 }..test socket-1
1c60: 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .4 {arg parsing
1c70: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1c80: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1c90: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1ca0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
1cb0: 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d ddr 127.0.0.1} m
1cc0: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
1cd0: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
1ce0: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
1cf0: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
1d00: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
1d10: 20 73 6f 63 6b 65 74 2d 31 2e 35 20 7b 61 72 67 socket-1.5 {arg
1d20: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
1d30: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
1d40: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
1d50: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
1d60: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 cket -myport} ms
1d70: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
1d80: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
1d90: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
1da0: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
1db0: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
1dc0: 73 6f 63 6b 65 74 2d 31 2e 36 20 7b 61 72 67 20 socket-1.6 {arg
1dd0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
1de0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
1df0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
1e00: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
1e10: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 ket -myport xxxx
1e20: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
1e30: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
1e40: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
1e50: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
1e60: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
1e70: 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 37 20 7b est socket-1.7 {
1e80: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
1e90: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
1ea0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
1eb0: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
1ec0: 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 :socket -myport
1ed0: 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 2522} msg] $msg.
1ee0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
1ef0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
1f00: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
1f10: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
1f20: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 }..test socket-1
1f30: 2e 38 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .8 {arg parsing
1f40: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1f50: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1f60: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1f70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f tls::socket -fro
1f80: 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d boz} msg] $msg.}
1f90: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
1fa0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
1fb0: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
1fc0: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
1fd0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e ..test socket-1.
1fe0: 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 9 {arg parsing f
1ff0: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2000: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2010: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2020: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2030: 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 er foo -myport 2
2040: 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 20 24 521 3333} msg] $
2050: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2060: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2070: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
2080: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
2090: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
20a0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e ..test socket-1.
20b0: 31 30 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 10 {arg parsing
20c0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
20d0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
20e0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
20f0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 74 tls::socket host
2100: 20 32 35 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 67 2528 -junk} msg
2110: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
2120: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
2130: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
2140: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
2150: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 port"}}..test s
2160: 6f 63 6b 65 74 2d 31 2e 31 31 20 7b 61 72 67 20 ocket-1.11 {arg
2170: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
2180: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2190: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
21a0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
21b0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 61 6c 6c ket -server call
21c0: 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d 20 6d 73 back 2520 --} ms
21d0: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
21e0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
21f0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2200: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
2210: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
2220: 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 t"}}..test socke
2230: 74 2d 31 2e 31 32 20 7b 61 72 67 20 70 61 72 73 t-1.12 {arg pars
2240: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
2250: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
2260: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
2270: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2280: 66 6f 6f 20 62 61 64 70 6f 72 74 7d 20 6d 73 67 foo badport} msg
2290: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 65 78 70 ] $msg.} {1 {exp
22a0: 65 63 74 65 64 20 69 6e 74 65 67 65 72 20 62 75 ected integer bu
22b0: 74 20 67 6f 74 20 22 62 61 64 70 6f 72 74 22 7d t got "badport"}
22c0: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 }..test socket-2
22d0: 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .1 {tcp connecti
22e0: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 on} {socket stdi
22f0: 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 o pcCrash} {.
2300: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
2310: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
2320: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
2330: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
2340: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
2350: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
2360: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
2370: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
2380: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
2390: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
23a0: 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 2828]..proc acc
23b0: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
23c0: 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 ort} {.. glob
23d0: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
23e0: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
23f0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
2400: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
2410: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
2420: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
2430: 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 $f..puts $x.
2440: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
2450: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
2460: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
2470: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
2480: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
2490: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
24a0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
24b0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 t 127.0.0.1 2828
24c0: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
24d0: 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 set x $msg.
24e0: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
24f0: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
2500: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
2510: 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ose $msg. }.
2520: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
2530: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
2540: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
2550: 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a {ready done {}}.
2560: 0a 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 .if [info exists
2570: 20 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 port] {. inc
2580: 72 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 20 r port.} else {
2590: 0a 20 20 20 20 73 65 74 20 70 6f 72 74 20 5b 65 . set port [e
25a0: 78 70 72 20 32 30 34 38 20 2b 20 5b 70 69 64 5d xpr 2048 + [pid]
25b0: 25 31 30 32 34 5d 0a 7d 0a 0a 74 65 73 74 20 73 %1024].}..test s
25c0: 6f 63 6b 65 74 2d 32 2e 32 20 7b 74 63 70 20 63 ocket-2.2 {tcp c
25d0: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 onnection with c
25e0: 6c 69 65 6e 74 20 70 6f 72 74 20 73 70 65 63 69 lient port speci
25f0: 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 fied} {socket st
2600: 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 dio pcCrash} {.
2610: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
2620: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
2630: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
2640: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
2650: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
2660: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
2670: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
2680: 64 6f 6e 65 22 5d 0a 20 20 20 20 20 20 20 20 73 done"]. s
2690: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
26a0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
26b0: 20 32 38 32 39 5d 0a 09 70 72 6f 63 20 61 63 63 2829]..proc acc
26c0: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
26d0: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
26e0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
26f0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
2700: 65 74 73 20 24 66 69 6c 65 5d 20 24 70 6f 72 74 ets $file] $port
2710: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
2720: 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 ose $file.
2730: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
2740: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
2750: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
2760: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
2770: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
2780: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2790: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
27a0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
27b0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
27c0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
27d0: 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 74 . global port
27e0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
27f0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
2800: 70 6f 72 74 20 24 70 6f 72 74 20 31 32 37 2e 30 port $port 127.0
2810: 2e 30 2e 31 20 32 38 32 39 7d 20 73 6f 63 6b 5d .0.1 2829} sock]
2820: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
2830: 78 20 24 73 6f 63 6b 0a 09 63 6c 6f 73 65 20 5b x $sock..close [
2840: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
2850: 30 2e 30 2e 31 20 32 38 32 39 5d 0a 09 70 75 74 0.0.1 2829]..put
2860: 73 20 73 74 64 65 72 72 20 24 73 6f 63 6b 0a 20 s stderr $sock.
2870: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
2880: 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 puts $sock h
2890: 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 ello..flush $soc
28a0: 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e k. lappen
28b0: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
28c0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 close $soc
28d0: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 k. }. clos
28e0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
28f0: 20 5b 6c 69 73 74 20 72 65 61 64 79 20 22 68 65 [list ready "he
2900: 6c 6c 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 65 73 llo $port"]..tes
2910: 74 20 73 6f 63 6b 65 74 2d 32 2e 33 20 7b 74 63 t socket-2.3 {tc
2920: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 p connection wit
2930: 68 20 63 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 h client interfa
2940: 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 ce specified} {s
2950: 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 ocket stdio pcCr
2960: 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ash} {. remov
2970: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
2980: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
2990: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
29a0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
29b0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
29c0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
29d0: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 "set x done"].
29e0: 20 20 20 20 20 20 20 73 65 74 20 66 20 5b 74 6c set f [tl
29f0: 73 3a 3a 73 6f 63 6b 65 74 20 20 2d 73 65 72 76 s::socket -serv
2a00: 65 72 20 61 63 63 65 70 74 20 32 38 33 30 5d 0a er accept 2830].
2a10: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 .proc accept {fi
2a20: 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a le addr port} {.
2a30: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
2a40: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
2a50: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 puts "[gets $fi
2a60: 6c 65 5d 20 24 61 64 64 72 22 0a 20 20 20 20 20 le] $addr".
2a70: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 close $fi
2a80: 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 le. s
2a90: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
2aa0: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
2ab0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
2ac0: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
2ad0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
2ae0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
2af0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
2b00: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
2b10: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
2b20: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
2b30: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
2b40: 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 32 ocket -myaddr 12
2b50: 37 2e 30 2e 30 2e 31 20 31 32 37 2e 30 2e 30 2e 7.0.0.1 127.0.0.
2b60: 31 20 32 38 33 30 7d 20 73 6f 63 6b 5d 7d 20 7b 1 2830} sock]} {
2b70: 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 . set x $
2b80: 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 sock. } else
2b90: 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 {. puts $
2ba0: 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 sock hello..flus
2bb0: 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 h $sock.
2bc0: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
2bd0: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
2be0: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
2bf0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2c00: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 et x.} {ready {h
2c10: 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d ello 127.0.0.1}}
2c20: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e ..test socket-2.
2c30: 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 4 {tcp connectio
2c40: 6e 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e n with server in
2c50: 74 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 terface specifie
2c60: 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f d} {socket stdio
2c70: 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 pcCrash} {.
2c80: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
2c90: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
2ca0: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
2cb0: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
2cc0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
2cd0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
2ce0: 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 2000 "set x don
2cf0: 65 22 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 e"]. set
2d00: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
2d10: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 6d server accept -m
2d20: 79 61 64 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 yaddr [info host
2d30: 6e 61 6d 65 5d 20 32 38 33 31 5d 0a 09 70 72 6f name] 2831]..pro
2d40: 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 c accept {file a
2d50: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 ddr port} {.
2d60: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
2d70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
2d80: 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 s "[gets $file]"
2d90: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
2da0: 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 se $file.
2db0: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
2dc0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
2dd0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
2de0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
2df0: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
2e00: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2e10: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
2e20: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
2e30: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
2e40: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
2e50: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
2e60: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 tls::socket [inf
2e70: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 o hostname] 2831
2e80: 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 } sock]} {.
2e90: 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 set x $sock.
2ea0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
2eb0: 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 puts $sock h
2ec0: 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 ello..flush $soc
2ed0: 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e k. lappen
2ee0: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
2ef0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 close $soc
2f00: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 k. }. clos
2f10: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
2f20: 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 {ready hello}.t
2f30: 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 35 20 7b est socket-2.5 {
2f40: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 tcp connection w
2f50: 69 74 68 20 72 65 64 75 6e 64 61 6e 74 20 73 65 ith redundant se
2f60: 72 76 65 72 20 70 6f 72 74 7d 20 7b 73 6f 63 6b rver port} {sock
2f70: 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 et stdio pcCrash
2f80: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
2f90: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
2fa0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
2fb0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
2fc0: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
2fd0: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
2fe0: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
2ff0: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
3000: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
3010: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
3020: 63 63 65 70 74 20 32 38 33 32 5d 0a 09 70 72 6f ccept 2832]..pro
3030: 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 c accept {file a
3040: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 ddr port} {.
3050: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
3060: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
3070: 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 s "[gets $file]"
3080: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
3090: 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 se $file.
30a0: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
30b0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
30c0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
30d0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
30e0: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
30f0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
3100: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
3110: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
3120: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
3130: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
3140: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
3150: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
3160: 30 2e 30 2e 31 20 32 38 33 32 7d 20 73 6f 63 6b 0.0.1 2832} sock
3170: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
3180: 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 x $sock. } e
3190: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 lse {. pu
31a0: 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 ts $sock hello..
31b0: 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 flush $sock.
31c0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
31d0: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
31e0: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
31f0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
3200: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
3210: 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 20 73 6f y hello}.test so
3220: 63 6b 65 74 2d 32 2e 36 20 7b 74 63 70 20 63 6f cket-2.6 {tcp co
3230: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
3240: 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 t} {. set sta
3250: 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 tus ok. if {!
3260: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 6f 63 6b [catch {set sock
3270: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
3280: 37 2e 30 2e 30 2e 31 20 32 38 33 33 5d 7d 5d 7d 7.0.0.1 2833]}]}
3290: 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 {..if {![catch
32a0: 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b {gets $sock}]} {
32b0: 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 75 73 .. set status
32c0: 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 broken..}..clos
32d0: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
32e0: 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f set status.} o
32f0: 6b 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e k.test socket-2.
3300: 37 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 7 {echo server,
3310: 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 one line} {socke
3320: 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d t stdio pcCrash}
3330: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
3340: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
3350: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3360: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
3370: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
3380: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
3390: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
33a0: 74 20 78 20 64 6f 6e 65 22 5d 0a 09 73 65 74 20 t x done"]..set
33b0: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
33c0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
33d0: 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 34]..proc accept
33e0: 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 {s a p} {.
33f0: 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 fileevent
3400: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
3410: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
3420: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
3430: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d translation lf -
3440: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
3450: 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 }..proc e
3460: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 cho {s} {..
3470: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
3480: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
3490: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 {[eof $s]} {.
34a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c gl
34b0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
34c0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
34d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
34e0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
34f0: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
3500: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
3510: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
3520: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
3530: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
3540: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
3550: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
3560: 65 20 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a e $f..puts done.
3570: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
3580: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
3590: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
35a0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
35b0: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
35c0: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 ets $f. set s
35d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
35e0: 37 2e 30 2e 30 2e 31 20 32 38 33 34 5d 0a 20 20 7.0.0.1 2834].
35f0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
3600: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
3610: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a -translation lf.
3620: 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 6c puts $s "hel
3630: 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d lo abcdefghijklm
3640: 6e 6f 70 22 0a 20 20 20 20 61 66 74 65 72 20 31 nop". after 1
3650: 30 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 67 000. set x [g
3660: 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ets $s]. clos
3670: 65 20 24 73 0a 20 20 20 20 73 65 74 20 79 20 5b e $s. set y [
3680: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
3690: 73 65 20 24 66 0a 20 20 20 20 6c 69 73 74 20 24 se $f. list $
36a0: 78 20 24 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 x $y.} {{hello a
36b0: 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d bcdefghijklmnop}
36c0: 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 73 6f 63 done}..test soc
36d0: 6b 65 74 2d 32 2e 38 20 7b 65 63 68 6f 20 73 65 ket-2.8 {echo se
36e0: 72 76 65 72 2c 20 6c 6f 6f 70 20 35 30 20 74 69 rver, loop 50 ti
36f0: 6d 65 73 2c 20 73 69 6e 67 6c 65 20 63 6f 6e 6e mes, single conn
3700: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 ection} {socket
3710: 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b stdio pcCrash} {
3720: 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a . makeFile {.
3730: 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 .package req
3740: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66 20 uire tls..set f
3750: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
3760: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 35 rver accept 2835
3770: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
3780: 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 s a p} {.
3790: 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 fileevent $
37a0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
37b0: 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 echo $s].
37c0: 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 fconfigure
37d0: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
37e0: 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 ine. }..p
37f0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
3800: 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 global i.
3810: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c set l
3820: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 [gets $s].
3830: 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 if {[eof
3840: 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 $s]} {.
3850: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
3860: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
3870: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
3880: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
3890: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
38a0: 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 } else { ..
38b0: 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a incr i.
38c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38d0: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
38e0: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 }..}..s
38f0: 65 74 20 69 20 30 0a 09 70 75 74 73 20 72 65 61 et i 0..puts rea
3900: 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 dy..set timer [a
3910: 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 20 fter 20000 "set
3920: 78 20 64 6f 6e 65 22 5d 0a 09 76 77 61 69 74 20 x done"]..vwait
3930: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
3940: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
3950: 0a 09 70 75 74 73 20 22 64 6f 6e 65 20 24 69 22 ..puts "done $i"
3960: 0a 20 20 20 20 7d 20 73 63 72 69 70 74 0a 20 20 . } script.
3970: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3980: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3990: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
39a0: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
39b0: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
39c0: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
39d0: 2e 31 20 32 38 33 35 5d 0a 20 20 20 20 66 63 6f .1 2835]. fco
39e0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
39f0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 ering line. c
3a00: 61 74 63 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 atch {..for {set
3a10: 20 78 20 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 x 0} {$x < 50}
3a20: 7b 69 6e 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 {incr x} {..
3a30: 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 puts $s "hello a
3a40: 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 bcdefghijklmnop"
3a50: 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d .. gets $s..}
3a60: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
3a70: 20 24 73 0a 20 20 20 20 63 61 74 63 68 20 7b 73 $s. catch {s
3a80: 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a et x [gets $f]}.
3a90: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3aa0: 20 73 65 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 set x.} {done 5
3ab0: 30 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 0}..test socket-
3ac0: 32 2e 39 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 2.9 {socket conf
3ad0: 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 lict} {socket st
3ae0: 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 dio} {. set s
3af0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
3b00: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
3b10: 38 5d 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 8]. removeFil
3b20: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
3b30: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3b40: 77 5d 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e w]. puts -non
3b50: 65 77 6c 69 6e 65 20 24 66 20 7b 70 61 63 6b 61 ewline $f {packa
3b60: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 3b 20 ge require tls;
3b70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3b80: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 7d ver accept 2828}
3b90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3ba0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3bb0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3bc0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3bd0: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
3be0: 66 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 0a f. after 100.
3bf0: 20 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 set x [list
3c00: 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 [catch {close $f
3c10: 7d 20 6d 73 67 5d 20 24 6d 73 67 5d 0a 20 20 20 } msg] $msg].
3c20: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
3c30: 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e t x.} {1 {couldn
3c40: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
3c50: 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 address already
3c60: 69 6e 20 75 73 65 0a 20 20 20 20 77 68 69 6c 65 in use. while
3c70: 20 65 78 65 63 75 74 69 6e 67 0a 22 3a 3a 73 6f executing."::so
3c80: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 7b 74 6c cket -server {tl
3c90: 73 3a 3a 5f 61 63 63 65 70 74 20 7b 2d 73 65 72 s::_accept {-ser
3ca0: 76 65 72 20 31 7d 20 61 63 63 65 70 74 7d 20 32 ver 1} accept} 2
3cb0: 38 32 38 22 0a 20 20 20 20 28 22 65 76 61 6c 22 828". ("eval"
3cc0: 20 62 6f 64 79 20 6c 69 6e 65 20 31 29 0a 20 20 body line 1).
3cd0: 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 invoked from w
3ce0: 69 74 68 69 6e 0a 22 65 76 61 6c 20 3a 3a 73 6f ithin."eval ::so
3cf0: 63 6b 65 74 20 24 73 6f 70 74 73 22 0a 20 20 20 cket $sopts".
3d00: 20 28 70 72 6f 63 65 64 75 72 65 20 22 74 6c 73 (procedure "tls
3d10: 3a 3a 73 6f 63 6b 65 74 22 20 6c 69 6e 65 20 36 ::socket" line 6
3d20: 32 29 0a 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 2). invoked f
3d30: 72 6f 6d 20 77 69 74 68 69 6e 0a 22 74 6c 73 3a rom within."tls:
3d40: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
3d50: 61 63 63 65 70 74 20 32 38 32 38 22 0a 20 20 20 accept 2828".
3d60: 20 28 66 69 6c 65 20 22 73 63 72 69 70 74 22 20 (file "script"
3d70: 6c 69 6e 65 20 31 29 7d 7d 0a 0a 74 65 73 74 20 line 1)}}..test
3d80: 73 6f 63 6b 65 74 2d 32 2e 31 30 20 7b 63 6c 6f socket-2.10 {clo
3d90: 73 65 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 se on accept, ac
3da0: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 cepted socket li
3db0: 76 65 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 ves} {socket pcC
3dc0: 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 rash} {. set
3dd0: 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 done 0. set t
3de0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
3df0: 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 0 "set done time
3e00: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 d_out"]. set
3e10: 73 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ss [tls::socket
3e20: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
3e30: 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 830]. proc ac
3e40: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
3e50: 67 6c 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 global ss..close
3e60: 20 24 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 $ss..fileevent
3e70: 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $s readable "rea
3e80: 64 69 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 dit $s"..fconfig
3e90: 75 72 65 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 ure $s -trans lf
3ea0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
3eb0: 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c readit {s} {..gl
3ec0: 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 obal done..gets
3ed0: 24 73 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 $s..close $s..se
3ee0: 74 20 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 t done 1. }.
3ef0: 20 20 20 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a set cs [tls::
3f00: 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 socket [info hos
3f10: 74 6e 61 6d 65 5d 20 32 38 33 30 5d 0a 20 20 20 tname] 2830].
3f20: 20 70 75 74 73 20 24 63 73 20 68 65 6c 6c 6f 0a puts $cs hello.
3f30: 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a 20 20 close $cs.
3f40: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
3f50: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
3f60: 69 6d 65 72 0a 20 20 20 20 73 65 74 20 64 6f 6e imer. set don
3f70: 65 0a 7d 20 31 0a 74 65 73 74 20 73 6f 63 6b 65 e.} 1.test socke
3f80: 74 2d 32 2e 31 31 20 7b 64 65 74 65 63 74 69 6e t-2.11 {detectin
3f90: 67 20 6e 65 77 20 64 61 74 61 7d 20 7b 73 6f 63 g new data} {soc
3fa0: 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 ket pcCrash} {.
3fb0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
3fc0: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
3fd0: 20 73 6f 63 6b 0a 09 73 65 74 20 73 6f 63 6b 20 sock..set sock
3fe0: 24 73 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 $s. }.. se
3ff0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
4000: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4010: 32 34 30 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 2400]. set so
4020: 63 6b 20 22 22 0a 20 20 20 20 73 65 74 20 73 32 ck "". set s2
4030: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
4040: 37 2e 30 2e 30 2e 31 20 32 34 30 30 5d 0a 20 20 7.0.0.1 2400].
4050: 20 20 76 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 vwait sock.
4060: 20 70 75 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 puts $s2 one.
4070: 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 flush $s2.
4080: 61 66 74 65 72 20 35 30 30 0a 20 20 20 20 66 63 after 500. fc
4090: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
40a0: 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 blocking 0. s
40b0: 65 74 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 et result [gets
40c0: 24 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 $sock]. lappe
40d0: 6e 64 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 nd result [gets
40e0: 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 $sock]. fconf
40f0: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
4100: 63 6b 69 6e 67 20 31 0a 20 20 20 20 70 75 74 73 cking 1. puts
4110: 20 24 73 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 $s2 two. flu
4120: 73 68 20 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 sh $s2. fconf
4130: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
4140: 63 6b 69 6e 67 20 30 0a 20 20 20 20 6c 61 70 70 cking 0. lapp
4150: 65 6e 64 20 72 65 73 75 6c 74 20 5b 67 65 74 73 end result [gets
4160: 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e $sock]. fcon
4170: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c figure $sock -bl
4180: 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f ocking 1. clo
4190: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
41a0: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
41b0: 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 65 73 75 ock. set resu
41c0: 6c 74 0a 7d 20 7b 6f 6e 65 20 7b 7d 20 74 77 6f lt.} {one {} two
41d0: 7d 0a 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }...test socket-
41e0: 33 2e 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 3.1 {socket conf
41f0: 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 lict} {socket st
4200: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
4210: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
4220: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
4230: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
4240: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
4250: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
4260: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
4270: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
4280: 20 32 38 32 38 5d 0a 09 70 75 74 73 20 72 65 61 2828]..puts rea
4290: 64 79 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 dy..gets stdin..
42a0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 close $f. }.
42b0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
42c0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
42d0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
42e0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
42f0: 20 72 2b 5d 0a 20 20 20 20 67 65 74 73 20 24 66 r+]. gets $f
4300: 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 . set x [list
4310: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
4320: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4330: 65 70 74 20 32 38 32 38 7d 20 6d 73 67 5d 20 5c ept 2828} msg] \
4340: 0a 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 75 74 ...$msg]. put
4350: 73 20 24 66 20 62 79 65 0a 20 20 20 20 63 6c 6f s $f bye. clo
4360: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
4370: 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f } {1 {couldn't o
4380: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 pen socket: addr
4390: 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 ess already in u
43a0: 73 65 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 se}}..test socke
43b0: 74 2d 33 2e 32 20 7b 73 65 72 76 65 72 20 77 69 t-3.2 {server wi
43c0: 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e th several clien
43d0: 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ts} {socket stdi
43e0: 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 o pcCrash} {.
43f0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
4400: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
4410: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
4420: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
4430: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
4440: 74 6c 73 0a 09 73 65 74 20 74 31 20 5b 61 66 74 tls..set t1 [aft
4450: 65 72 20 33 30 30 30 30 20 22 73 65 74 20 78 20 er 30000 "set x
4460: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 timed_out"]..set
4470: 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 t2 [after 31000
4480: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
4490: 74 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 66 74 t"]..set t3 [aft
44a0: 65 72 20 33 32 30 30 30 20 22 73 65 74 20 78 20 er 32000 "set x
44b0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 timed_out"]..set
44c0: 20 63 6f 75 6e 74 65 72 20 30 0a 09 73 65 74 20 counter 0..set
44d0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
44e0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
44f0: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
4500: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
4510: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
4520: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
4530: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
4540: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
4550: 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 ng line..}..proc
4560: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
4570: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
4580: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
4590: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
45a0: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
45b0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
45c0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
45d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45e0: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
45f0: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
4600: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4610: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
4620: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
4630: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
4640: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
4650: 6c 20 24 74 31 0a 09 76 77 61 69 74 20 78 0a 09 l $t1..vwait x..
4660: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 after cancel $t2
4670: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
4680: 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f cancel $t3..clo
4690: 73 65 20 24 73 0a 09 70 75 74 73 20 24 78 0a 20 se $s..puts $x.
46a0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
46b0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
46c0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
46d0: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
46e0: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 73 ript]" r+]. s
46f0: 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 et x [gets $f].
4700: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
4710: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
4720: 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 2828]. fconf
4730: 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 igure $s1 -buffe
4740: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
4750: 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s2 [tls::socke
4760: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 t 127.0.0.1 2828
4770: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4780: 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 $s2 -buffering
4790: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 line. set s3
47a0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
47b0: 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 .0.0.1 2828].
47c0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 20 fconfigure $s3
47d0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
47e0: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
47f0: 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e } {$i < 100} {in
4800: 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 cr i} {..puts $s
4810: 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 1 hello,s1..gets
4820: 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 $s1..puts $s2 h
4830: 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 73 ello,s2..gets $s
4840: 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 2..puts $s3 hell
4850: 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 o,s3..gets $s3.
4860: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
4870: 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 s1. close $s2
4880: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 . close $s3.
4890: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
48a0: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
48b0: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
48c0: 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 {ready done}..te
48d0: 73 74 20 73 6f 63 6b 65 74 2d 34 2e 31 20 7b 73 st socket-4.1 {s
48e0: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
48f0: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 al clients} {soc
4900: 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 ket stdio pcCras
4910: 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 h} {. removeF
4920: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
4930: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
4940: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
4950: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
4960: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 require tls..get
4970: 73 20 73 74 64 69 6e 0a 09 73 65 74 20 73 20 5b s stdin..set s [
4980: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
4990: 30 2e 30 2e 31 20 32 38 32 38 5d 0a 09 66 63 6f 0.0.1 2828]..fco
49a0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
49b0: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 ering line..for
49c0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
49d0: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
49e0: 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c . puts $s hel
49f0: 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a lo.. gets $s.
4a00: 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 .}..close $s..pu
4a10: 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 ts bye..gets std
4a20: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f in. }. clo
4a30: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 se $f. set p1
4a40: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
4a50: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
4a60: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
4a70: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
4a80: 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p1 -buffering li
4a90: 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f ne. set p2 [o
4aa0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
4ab0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
4ac0: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
4ad0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 20 fconfigure $p2
4ae0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
4af0: 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 6e set p3 [open
4b00: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
4b10: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
4b20: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 ipt]" r+]. fc
4b30: 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 75 onfigure $p3 -bu
4b40: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
4b50: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
4b60: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
4b70: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
4b80: 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 line..fileevent
4b90: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
4ba0: 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 st echo $s].
4bb0: 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f 20 }. proc echo
4bc0: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a {s} {..global x.
4bd0: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
4be0: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
4bf0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
4c00: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
4c10: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
4c20: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
4c30: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
4c40: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
4c50: 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 $l. }.
4c60: 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 5b }. set t1 [
4c70: 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74 after 30000 "set
4c80: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
4c90: 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 72 set t2 [after
4ca0: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
4cb0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 med_out"]. se
4cc0: 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 30 t t3 [after 3200
4cd0: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
4ce0: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 5b ut"]. set s [
4cf0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4d00: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d ver accept 2828]
4d10: 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 6f 70 . puts $p1 op
4d20: 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 en. puts $p2
4d30: 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 open. puts $p
4d40: 33 20 6f 70 65 6e 0a 20 20 20 20 76 77 61 69 74 3 open. vwait
4d50: 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 x. vwait x.
4d60: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 vwait x. a
4d70: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a fter cancel $t1.
4d80: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
4d90: 20 24 74 32 0a 20 20 20 20 61 66 74 65 72 20 63 $t2. after c
4da0: 61 6e 63 65 6c 20 24 74 33 0a 20 20 20 20 63 6c ancel $t3. cl
4db0: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 6c ose $s. set l
4dc0: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
4dd0: 6c 20 5b 6c 69 73 74 20 70 31 20 5b 67 65 74 73 l [list p1 [gets
4de0: 20 24 70 31 5d 20 24 78 5d 0a 20 20 20 20 6c 61 $p1] $x]. la
4df0: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 32 ppend l [list p2
4e00: 20 5b 67 65 74 73 20 24 70 32 5d 20 24 78 5d 0a [gets $p2] $x].
4e10: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
4e20: 69 73 74 20 70 33 20 5b 67 65 74 73 20 24 70 33 ist p3 [gets $p3
4e30: 5d 20 24 78 5d 0a 20 20 20 20 70 75 74 73 20 24 ] $x]. puts $
4e40: 70 31 20 62 79 65 0a 20 20 20 20 70 75 74 73 20 p1 bye. puts
4e50: 24 70 32 20 62 79 65 0a 20 20 20 20 70 75 74 73 $p2 bye. puts
4e60: 20 24 70 33 20 62 79 65 0a 20 20 20 20 63 6c 6f $p3 bye. clo
4e70: 73 65 20 24 70 31 0a 20 20 20 20 63 6c 6f 73 65 se $p1. close
4e80: 20 24 70 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $p2. close $
4e90: 70 33 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b p3. set l.} {
4ea0: 7b 70 31 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 {p1 bye done} {p
4eb0: 32 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 33 20 2 bye done} {p3
4ec0: 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 73 74 bye done}}..test
4ed0: 20 73 6f 63 6b 65 74 2d 34 2e 32 20 7b 62 79 74 socket-4.2 {byt
4ee0: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
4ef0: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
4f00: 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 , htons} {socket
4f10: 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 6f 6b } {. set x ok
4f20: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
4f30: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
4f40: 72 76 65 72 20 64 6f 64 6f 20 30 78 33 30 30 30 rver dodo 0x3000
4f50: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
4f60: 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 $msg. } else
4f70: 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 {..close $msg.
4f80: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
4f90: 20 6f 6b 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 ok..test socket
4fa0: 2d 35 2e 31 20 7b 62 79 74 65 20 6f 72 64 65 72 -5.1 {byte order
4fb0: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
4fc0: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
4fd0: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 } \..{socket uni
4fe0: 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b xOnly notRoot} {
4ff0: 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c . set x {coul
5000: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
5010: 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 : not owner}.
5020: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c if {![catch {tl
5030: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5040: 72 20 64 6f 64 6f 20 30 78 31 7d 20 6d 73 67 5d r dodo 0x1} msg]
5050: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
5060: 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d x {htons problem
5070: 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 , should be disa
5080: 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 llowed, are you
5090: 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a running as SU?}.
50a0: 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 .close $msg.
50b0: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 }. set x.} {c
50c0: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
50d0: 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a ket: not owner}.
50e0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 35 2e 32 20 test socket-5.2
50f0: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
5100: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
5110: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f bers, htons} {so
5120: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
5130: 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e x {couldn't open
5140: 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 socket: port nu
5150: 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 20 mber too high}.
5160: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
5170: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
5180: 76 65 72 20 64 6f 64 6f 20 30 78 31 30 30 30 30 ver dodo 0x10000
5190: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
51a0: 20 7b 70 6f 72 74 20 72 65 73 6f 6c 75 74 69 6f {port resolutio
51b0: 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c n problem, shoul
51c0: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 7d d be disallowed}
51d0: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 ..close $msg.
51e0: 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b }. set x.} {
51f0: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
5200: 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 cket: port numbe
5210: 72 20 74 6f 6f 20 68 69 67 68 7d 0a 74 65 73 74 r too high}.test
5220: 20 73 6f 63 6b 65 74 2d 35 2e 33 20 7b 62 79 74 socket-5.3 {byt
5230: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
5240: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
5250: 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 , htons} \..{soc
5260: 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 ket unixOnly not
5270: 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 Root} {. set
5280: 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e x {couldn't open
5290: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
52a0: 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 er}. if {![ca
52b0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
52c0: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 32 31 -server dodo 21
52d0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
52e0: 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c {htons problem,
52f0: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
5300: 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 lowed, are you r
5310: 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 unning as SU?}..
5320: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
5330: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f . set x.} {co
5340: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5350: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a et: not owner}..
5360: 74 65 73 74 20 73 6f 63 6b 65 74 2d 36 2e 31 20 test socket-6.1
5370: 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b {accept callback
5380: 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 error} {socket
5390: 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b stdio pcCrash} {
53a0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
53b0: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
53c0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
53d0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 . puts $f {.
53e0: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
53f0: 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 ire tls..gets st
5400: 64 69 6e 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 74 din..tls::socket
5410: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 34 38 0a 127.0.0.1 2848.
5420: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
5430: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
5440: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
5450: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
5460: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
5470: 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 proc bgerror arg
5480: 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 s {..global x..s
5490: 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d et x $args. }
54a0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
54b0: 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 {s a p} {expr 1
54c0: 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 20 73 0 / 0}. set s
54d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
54e0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 34 erver accept 284
54f0: 38 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 8]. puts $f h
5500: 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 20 24 ello. close $
5510: 66 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 f. set timer
5520: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
5530: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
5540: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
5550: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
5560: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
5570: 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 65 72 . rename bger
5580: 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 20 78 ror {}. set x
5590: 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 20 7a .} {{divide by z
55a0: 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b ero}}..test sock
55b0: 65 74 2d 37 2e 31 20 7b 74 65 73 74 69 6e 67 20 et-7.1 {testing
55c0: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
55d0: 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 options} {socket
55e0: 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 stdio pcCrash}
55f0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
5600: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
5610: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
5620: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
5630: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
5640: 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 tls..tls::socke
5650: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
5660: 20 32 38 32 30 0a 09 70 72 6f 63 20 61 63 63 65 2820..proc acce
5670: 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 pt args {.. g
5680: 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 lobal x.. set
5690: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
56a0: 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 ready..set time
56b0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
56c0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
56d0: 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 ]..vwait x..afte
56e0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
56f0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
5700: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
5710: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
5720: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
5730: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
5740: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 ets $f. set s
5750: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
5760: 37 2e 30 2e 30 2e 31 20 32 38 32 30 5d 0a 20 20 7.0.0.1 2820].
5770: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
5780: 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 ure $s -peername
5790: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
57a0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
57b0: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
57c0: 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 pend l [string c
57d0: 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 ompare [lindex $
57e0: 70 20 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d 0a p 0] 127.0.0.1].
57f0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 lappend l [s
5800: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c tring compare [l
5810: 69 6e 64 65 78 20 24 70 20 32 5d 20 32 38 32 30 index $p 2] 2820
5820: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
5830: 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 7b [llength $p].} {
5840: 30 20 30 20 33 7d 0a 74 65 73 74 20 73 6f 63 6b 0 0 3}.test sock
5850: 65 74 2d 37 2e 32 20 7b 74 65 73 74 69 6e 67 20 et-7.2 {testing
5860: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
5870: 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 options} {socket
5880: 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d 20 stdio pcCrash}
5890: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
58a0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
58b0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
58c0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
58d0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
58e0: 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 tls..tls::socke
58f0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
5900: 20 32 38 32 31 0a 09 70 72 6f 63 20 61 63 63 65 2821..proc acce
5910: 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 pt args {.. g
5920: 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 lobal x.. set
5930: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
5940: 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 ready..set time
5950: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
5960: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5970: 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 ]..vwait x..afte
5980: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
5990: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
59a0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
59b0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
59c0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
59d0: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
59e0: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 ets $f. set s
59f0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
5a00: 37 2e 30 2e 30 2e 31 20 32 38 32 31 5d 0a 20 20 7.0.0.1 2821].
5a10: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
5a20: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 ure $s -sockname
5a30: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
5a40: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5a50: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
5a60: 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 pend l [llength
5a70: 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $p]. lappend
5a80: 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a l [lindex $p 0].
5a90: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 65 lappend l [e
5aa0: 78 70 72 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 xpr [lindex $p 2
5ab0: 5d 20 3d 3d 20 32 38 32 31 5d 0a 7d 20 7b 33 20 ] == 2821].} {3
5ac0: 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a 74 65 73 127.0.0.1 0}.tes
5ad0: 74 20 73 6f 63 6b 65 74 2d 37 2e 33 20 7b 74 65 t socket-7.3 {te
5ae0: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
5af0: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
5b00: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
5b10: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
5b20: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
5b30: 32 38 32 32 5d 0a 20 20 20 20 73 65 74 20 6c 20 2822]. set l
5b40: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 5d 0a [fconfigure $s].
5b50: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
5b60: 20 75 70 64 61 74 65 0a 20 20 20 20 6c 6c 65 6e update. llen
5b70: 67 74 68 20 24 6c 0a 7d 20 31 32 0a 74 65 73 74 gth $l.} 12.test
5b80: 20 73 6f 63 6b 65 74 2d 37 2e 34 20 7b 74 65 73 socket-7.4 {tes
5b90: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
5ba0: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 ific options} {s
5bb0: 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b ocket pcCrash} {
5bc0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
5bd0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
5be0: 61 63 63 65 70 74 20 32 38 32 33 5d 0a 20 20 20 accept 2823].
5bf0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
5c00: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 a p} {..global x
5c10: 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 ..set x [fconfig
5c20: 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 ure $s -sockname
5c30: 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 ]..close $s.
5c40: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
5c50: 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 s::socket [info
5c60: 68 6f 73 74 6e 61 6d 65 5d 20 32 38 32 33 5d 0a hostname] 2823].
5c70: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
5c80: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
5c90: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
5ca0: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 vwait x. af
5cb0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
5cc0: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
5cd0: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
5ce0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
5cf0: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
5d00: 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 $x 2] [llength $
5d10: 78 5d 0a 7d 20 7b 32 38 32 33 20 33 7d 0a 0a 74 x].} {2823 3}..t
5d20: 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 35 20 7b est socket-7.5 {
5d30: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
5d40: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
5d50: 20 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 72 50 {socket unixOrP
5d60: 63 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 c pcCrash} {.
5d70: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
5d80: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
5d90: 70 74 20 32 38 32 39 5d 0a 20 20 20 20 70 72 6f pt 2829]. pro
5da0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
5db0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 {..global x..se
5dc0: 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t x [fconfigure
5dd0: 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 $s -sockname]..c
5de0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
5df0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
5e00: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
5e10: 32 38 32 39 5d 0a 20 20 20 20 73 65 74 20 74 69 2829]. set ti
5e20: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
5e30: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
5e40: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
5e50: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
5e60: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
5e70: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
5e80: 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a s1. set l "".
5e90: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
5ea0: 69 6e 64 65 78 20 24 78 20 30 5d 20 5b 6c 69 6e index $x 0] [lin
5eb0: 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 dex $x 2] [lleng
5ec0: 74 68 20 24 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e th $x].} {127.0.
5ed0: 30 2e 31 20 32 38 32 39 20 33 7d 0a 0a 74 65 73 0.1 2829 3}..tes
5ee0: 74 20 73 6f 63 6b 65 74 2d 38 2e 31 20 7b 74 65 t socket-8.1 {te
5ef0: 73 74 69 6e 67 20 2d 61 73 79 6e 63 20 66 6c 61 sting -async fla
5f00: 67 20 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 7b 73 g on sockets} {s
5f10: 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b ocket pcCrash} {
5f20: 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 69 . # NOTE: Thi
5f30: 73 20 74 65 73 74 20 6d 61 79 20 66 61 69 6c 20 s test may fail
5f40: 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 20 on some Solaris
5f50: 32 2e 34 20 73 79 73 74 65 6d 73 2e 20 49 66 20 2.4 systems. If
5f60: 69 74 20 64 6f 65 73 2c 0a 20 20 20 20 23 20 63 it does,. # c
5f70: 68 65 63 6b 20 74 68 61 74 20 79 6f 75 20 68 61 heck that you ha
5f80: 76 65 20 74 68 65 73 65 20 70 61 74 63 68 65 73 ve these patches
5f90: 20 69 6e 73 74 61 6c 6c 65 64 20 28 75 73 69 6e installed (usin
5fa0: 67 20 73 68 6f 77 72 65 76 20 2d 70 29 3a 0a 20 g showrev -p):.
5fb0: 20 20 20 23 0a 20 20 20 20 23 20 31 30 31 39 30 #. # 10190
5fc0: 37 2d 30 35 2c 20 31 30 31 39 32 35 2d 30 32 2c 7-05, 101925-02,
5fd0: 20 31 30 31 39 34 35 2d 31 34 2c 20 31 30 31 39 101945-14, 1019
5fe0: 35 39 2d 30 33 2c 20 31 30 31 39 36 39 2d 30 35 59-03, 101969-05
5ff0: 2c 20 31 30 31 39 37 33 2d 30 33 2c 0a 20 20 20 , 101973-03,.
6000: 20 23 20 31 30 31 39 37 37 2d 30 33 2c 20 31 30 # 101977-03, 10
6010: 31 39 38 31 2d 30 32 2c 20 31 30 31 39 38 35 2d 1981-02, 101985-
6020: 30 31 2c 20 31 30 32 30 30 31 2d 30 33 2c 20 31 01, 102001-03, 1
6030: 30 32 30 30 33 2d 30 31 2c 20 31 30 32 30 30 37 02003-01, 102007
6040: 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 32 30 31 -01,. # 10201
6050: 31 2d 30 32 2c 20 31 30 32 30 32 34 2d 30 31 2c 1-02, 102024-01,
6060: 20 31 30 32 30 33 39 2d 30 31 2c 20 31 30 32 30 102039-01, 1020
6070: 34 34 2d 30 31 2c 20 31 30 32 30 34 38 2d 30 31 44-01, 102048-01
6080: 2c 20 31 30 32 30 36 32 2d 30 33 2c 0a 20 20 20 , 102062-03,.
6090: 20 23 20 31 30 32 30 36 36 2d 30 34 2c 20 31 30 # 102066-04, 10
60a0: 32 30 37 30 2d 30 31 2c 20 31 30 32 31 30 35 2d 2070-01, 102105-
60b0: 30 31 2c 20 31 30 32 31 35 33 2d 30 33 2c 20 31 01, 102153-03, 1
60c0: 30 32 32 31 36 2d 30 31 2c 20 31 30 32 32 33 32 02216-01, 102232
60d0: 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 31 38 37 -01,. # 10187
60e0: 38 2d 30 33 2c 20 31 30 31 38 37 39 2d 30 31 2c 8-03, 101879-01,
60f0: 20 31 30 31 38 38 30 2d 30 33 2c 20 31 30 31 39 101880-03, 1019
6100: 33 33 2d 30 31 2c 20 31 30 31 39 35 30 2d 30 31 33-01, 101950-01
6110: 2c 20 31 30 32 30 33 30 2d 30 31 2c 0a 20 20 20 , 102030-01,.
6120: 20 23 20 31 30 32 30 35 37 2d 30 38 2c 20 31 30 # 102057-08, 10
6130: 32 31 34 30 2d 30 31 2c 20 31 30 31 39 32 30 2d 2140-01, 101920-
6140: 30 32 2c 20 31 30 31 39 32 31 2d 30 39 2c 20 31 02, 101921-09, 1
6150: 30 31 39 32 32 2d 30 37 2c 20 31 30 31 39 32 33 01922-07, 101923
6160: 2d 30 33 0a 20 20 20 20 23 0a 20 20 20 20 23 20 -03. #. #
6170: 49 66 20 61 66 74 65 72 20 69 6e 73 74 61 6c 6c If after install
6180: 69 6e 67 20 74 68 65 73 65 20 70 61 74 63 68 65 ing these patche
6190: 73 20 79 6f 75 20 61 72 65 20 73 74 69 6c 6c 20 s you are still
61a0: 65 78 70 65 72 69 65 6e 63 69 6e 67 20 61 0a 20 experiencing a.
61b0: 20 20 20 23 20 70 72 6f 62 6c 65 6d 2c 20 70 6c # problem, pl
61c0: 65 61 73 65 20 65 6d 61 69 6c 20 6a 79 6c 40 65 ease email jyl@e
61d0: 6e 67 2e 73 75 6e 2e 63 6f 6d 2e 20 57 65 20 68 ng.sun.com. We h
61e0: 61 76 65 20 6e 6f 74 20 6f 62 73 65 72 76 65 64 ave not observed
61f0: 20 74 68 69 73 0a 20 20 20 20 23 20 66 61 69 6c this. # fail
6200: 75 72 65 20 6f 6e 20 53 6f 6c 61 72 69 73 20 32 ure on Solaris 2
6210: 2e 35 2c 20 73 6f 20 61 6e 6f 74 68 65 72 20 6f .5, so another o
6220: 70 74 69 6f 6e 20 28 69 6e 73 74 65 61 64 20 6f ption (instead o
6230: 66 20 69 6e 73 74 61 6c 6c 69 6e 67 0a 20 20 20 f installing.
6240: 20 23 20 74 68 65 73 65 20 70 61 74 63 68 65 73 # these patches
6250: 29 20 69 73 20 74 6f 20 75 70 67 72 61 64 65 20 ) is to upgrade
6260: 74 6f 20 53 6f 6c 61 72 69 73 20 32 2e 35 2e 0a to Solaris 2.5..
6270: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6280: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6290: 63 63 65 70 74 20 32 38 33 30 5d 0a 20 20 20 20 ccept 2830].
62a0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
62b0: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a p} {..global x.
62c0: 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c .puts $s bye..cl
62d0: 6f 73 65 20 24 73 0a 09 73 65 74 20 78 20 64 6f ose $s..set x do
62e0: 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 ne. }. set
62f0: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
6300: 20 2d 61 73 79 6e 63 20 5b 69 6e 66 6f 20 68 6f -async [info ho
6310: 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d 0a 20 20 stname] 2830].
6320: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 73 65 vwait x. se
6330: 74 20 7a 20 5b 67 65 74 73 20 24 73 31 5d 0a 20 t z [gets $s1].
6340: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
6350: 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 close $s1. se
6360: 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 65 73 74 20 t z.} bye..test
6370: 73 6f 63 6b 65 74 2d 39 2e 31 20 7b 74 65 73 74 socket-9.1 {test
6380: 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 ing spurious eve
6390: 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 nts} {socket pcC
63a0: 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 rash} {. set
63b0: 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 len 0. set sp
63c0: 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 urious 0. set
63d0: 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 done 0. proc
63e0: 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 readlittle {s}
63f0: 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f {..global spurio
6400: 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 us done len..set
6410: 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 l [read $s 1]..
6420: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 if {[string leng
6430: 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 th $l] == 0} {..
6440: 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 if {![eof $s
6450: 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 ]} {...incr spur
6460: 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 ious.. } else
6470: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 {...close $s...
6480: 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 set done 1..
6490: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 }..} else {..
64a0: 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e incr len [strin
64b0: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a g length $l]..}.
64c0: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 }. proc a
64d0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
64e0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
64f0: 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 20 2d buffering none -
6500: 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 66 69 blocking off..fi
6510: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
6520: 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 ble [list readli
6530: 74 74 6c 65 20 24 73 5d 0a 20 20 20 20 7d 0a 20 ttle $s]. }.
6540: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
6550: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
6560: 63 65 70 74 20 32 38 33 31 5d 0a 20 20 20 20 73 cept 2831]. s
6570: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
6580: 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 t [info hostname
6590: 5d 20 32 38 33 31 5d 0a 20 20 20 20 70 75 74 73 ] 2831]. puts
65a0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 30 -nonewline $c 0
65b0: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
65c0: 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 7890123456789012
65d0: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
65e0: 39 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 9. close $c.
65f0: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
6600: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 ter 10000 "set d
6610: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a one timed_out"].
6620: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
6630: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
6640: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
6650: 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 73 70 $s. list $sp
6660: 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 urious $len.} {0
6670: 20 35 30 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 50}..test socke
6680: 74 2d 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 61 t-9.2 {testing a
6690: 73 79 6e 63 20 77 72 69 74 65 2c 20 66 69 6c 65 sync write, file
66a0: 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f 6e events, flush on
66b0: 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 74 20 close} {socket
66c0: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 pcCrash} {. s
66d0: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 et firstblock ""
66e0: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
66f0: 30 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 0} {$i < 5} {inc
6700: 72 20 69 7d 20 7b 73 65 74 20 66 69 72 73 74 62 r i} {set firstb
6710: 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 62 6c 6f lock "a$firstblo
6720: 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 7d 0a ck$firstblock"}.
6730: 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c set secondbl
6740: 6f 63 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 7b ock "". for {
6750: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
6760: 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 73 6} {incr i} {..s
6770: 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 et secondblock "
6780: 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 b$secondblock$se
6790: 63 6f 6e 64 62 6c 6f 63 6b 22 0a 20 20 20 20 7d condblock". }
67a0: 0a 20 20 20 20 73 65 74 20 6c 20 5b 74 6c 73 3a . set l [tls:
67b0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
67c0: 61 63 63 65 70 74 20 32 38 33 32 5d 0a 20 20 20 accept 2832].
67d0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
67e0: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
67f0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
6800: 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 0 -translation l
6810: 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 f -buffersize 16
6820: 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 384 \...-bufferi
6830: 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 ng line..fileeve
6840: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 nt $s readable "
6850: 72 65 61 64 61 62 6c 65 20 24 73 22 0a 20 20 20 readable $s".
6860: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 }. proc read
6870: 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 able {s} {..set
6880: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 66 69 6c l [gets $s]..fil
6890: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
68a0: 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 le {}..after 100
68b0: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 0 respond $s.
68c0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 }. proc resp
68d0: 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 ond {s} {..globa
68e0: 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 70 75 l firstblock..pu
68f0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
6900: 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 61 66 $firstblock..af
6910: 74 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 ter 1000 writeda
6920: 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 ta $s. }.
6930: 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b proc writedata {
6940: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 65 63 s} {..global sec
6950: 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 74 73 20 2d ondblock..puts -
6960: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 nonewline $s $se
6970: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 condblock..close
6980: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
6990: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
69a0: 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d [info hostname]
69b0: 20 32 38 33 32 5d 0a 20 20 20 20 66 63 6f 6e 66 2832]. fconf
69c0: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
69d0: 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d ng 0 -trans lf -
69e0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
69f0: 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 set count 0.
6a00: 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f puts $s hello
6a10: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 . proc readit
6a20: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
6a30: 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c ount done..set l
6a40: 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 [read $s]..incr
6a50: 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c count [string l
6a60: 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b ength $l]..if {[
6a70: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
6a80: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 close $s.. se
6a90: 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 t done 1..}.
6aa0: 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 }. fileevent
6ab0: 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $s readable "rea
6ac0: 64 69 74 20 24 73 22 0a 20 20 20 20 73 65 74 20 dit $s". set
6ad0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
6ae0: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
6af0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
6b00: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
6b10: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
6b20: 20 20 20 20 63 6c 6f 73 65 20 24 6c 0a 20 20 20 close $l.
6b30: 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 set count.} 655
6b40: 36 36 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 66..test socket-
6b50: 39 2e 33 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 9.3 {testing EOF
6b60: 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 73 6f stickyness} {so
6b70: 63 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a cket pcCrash} {.
6b80: 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 74 proc count_t
6b90: 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f o_eof {s} {..glo
6ba0: 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 20 74 bal count done t
6bb0: 69 6d 65 72 0a 09 73 65 74 20 6c 20 5b 67 65 74 imer..set l [get
6bc0: 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 s $s]..if {[eof
6bd0: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 $s]} {.. incr
6be0: 20 63 6f 75 6e 74 0a 09 20 20 20 20 69 66 20 7b count.. if {
6bf0: 24 63 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 $count > 9} {...
6c00: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 close $s...set d
6c10: 6f 6e 65 20 74 72 75 65 0a 09 09 73 65 74 20 63 one true...set c
6c20: 6f 75 6e 74 20 7b 65 6f 66 20 69 73 20 73 74 69 ount {eof is sti
6c30: 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e cky}...after can
6c40: 63 65 6c 20 24 74 69 6d 65 72 0a 09 20 20 20 20 cel $timer..
6c50: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 }..}. }. p
6c60: 72 6f 63 20 74 69 6d 65 72 70 72 6f 63 20 7b 7d roc timerproc {}
6c70: 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 {..global done
6c80: 63 6f 75 6e 74 20 63 0a 09 73 65 74 20 64 6f 6e count c..set don
6c90: 65 20 74 72 75 65 0a 09 73 65 74 20 63 6f 75 6e e true..set coun
6ca0: 74 20 7b 74 69 6d 65 72 20 77 65 6e 74 20 6f 66 t {timer went of
6cb0: 66 2c 20 65 6f 66 20 69 73 20 6e 6f 74 20 73 74 f, eof is not st
6cc0: 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a icky}..close $c.
6cd0: 20 20 20 20 7d 09 0a 20 20 20 20 73 65 74 20 63 }.. set c
6ce0: 6f 75 6e 74 20 30 0a 20 20 20 20 73 65 74 20 64 ount 0. set d
6cf0: 6f 6e 65 20 66 61 6c 73 65 0a 20 20 20 20 70 72 one false. pr
6d00: 6f 63 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c oc write_then_cl
6d10: 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 75 74 73 20 ose {s} {..puts
6d20: 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 $s bye..close $s
6d30: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
6d40: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
6d50: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
6d60: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
6d70: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a -translation lf.
6d80: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 .fileevent $s wr
6d90: 69 74 61 62 6c 65 20 22 77 72 69 74 65 5f 74 68 itable "write_th
6da0: 65 6e 5f 63 6c 6f 73 65 20 24 73 22 0a 20 20 20 en_close $s".
6db0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
6dc0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6dd0: 72 20 61 63 63 65 70 74 20 32 38 33 33 5d 0a 20 r accept 2833].
6de0: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
6df0: 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 ocket [info host
6e00: 6e 61 6d 65 5d 20 32 38 33 33 5d 0a 20 20 20 20 name] 2833].
6e10: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 fconfigure $c -b
6e20: 6c 6f 63 6b 69 6e 67 20 6f 66 66 20 2d 62 75 66 locking off -buf
6e30: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
6e40: 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 nslation lf.
6e50: 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 fileevent $c rea
6e60: 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f dable "count_to_
6e70: 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 eof $c". set
6e80: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
6e90: 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 0 timerproc].
6ea0: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
6eb0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 close $s. set
6ec0: 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 count.} {eof is
6ed0: 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 sticky}..remove
6ee0: 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 File script..tes
6ef0: 74 20 73 6f 63 6b 65 74 2d 31 30 2e 31 20 7b 74 t socket-10.1 {t
6f00: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 esting socket ac
6f10: 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 cept callback er
6f20: 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 ror handling} {s
6f30: 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b ocket pcCrash} {
6f40: 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f . set goterro
6f50: 72 20 30 0a 20 20 20 20 70 72 6f 63 20 62 67 65 r 0. proc bge
6f60: 72 72 6f 72 20 61 72 67 73 20 7b 67 6c 6f 62 61 rror args {globa
6f70: 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 65 74 20 l goterror; set
6f80: 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 20 20 20 goterror 1}.
6f90: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
6fa0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
6fb0: 74 20 32 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 t 2898]. proc
6fc0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
6fd0: 7b 63 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 {close $s; error
6fe0: 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 }. set c [tls
6ff0: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
7000: 2e 31 20 32 38 39 38 5d 0a 20 20 20 20 76 77 61 .1 2898]. vwa
7010: 69 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 it goterror.
7020: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
7030: 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f se $c. set go
7040: 74 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 terror.} 1..test
7050: 20 73 6f 63 6b 65 74 2d 31 31 2e 31 20 7b 74 63 socket-11.1 {tc
7060: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 p connection} {s
7070: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
7080: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
7090: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
70a0: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f {..set socket9_
70b0: 31 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 1_test_server [t
70c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
70d0: 65 72 20 61 63 63 65 70 74 20 32 38 33 34 5d 0a er accept 2834].
70e0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
70f0: 61 20 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 a p} {.. puts
7100: 20 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 63 6c $s done.. cl
7110: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
7120: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
7130: 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 socket $remoteSe
7140: 72 76 65 72 49 50 20 32 38 33 34 5d 0a 20 20 20 rverIP 2834].
7150: 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d set r [gets $s]
7160: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
7170: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
7180: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 31 5f lose $socket9_1_
7190: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
71a0: 20 73 65 74 20 72 0a 7d 20 64 6f 6e 65 0a 74 65 set r.} done.te
71b0: 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 32 20 7b st socket-11.2 {
71c0: 63 6c 69 65 6e 74 20 73 70 65 63 69 66 69 65 73 client specifies
71d0: 20 69 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 6b its port} {sock
71e0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
71f0: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
7200: 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 if {[info exis
7210: 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 ts port]} {..inc
7220: 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 6c 73 r port. } els
7230: 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 5b 65 e {..set port [e
7240: 78 70 72 20 32 30 34 38 20 2b 20 5b 70 69 64 5d xpr 2048 + [pid]
7250: 25 31 30 32 34 5d 0a 20 20 20 20 7d 0a 20 20 20 %1024]. }.
7260: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
7270: 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 65 set socket9_2_te
7280: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
7290: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
72a0: 63 63 65 70 74 20 32 38 33 35 5d 0a 09 70 72 6f ccept 2835]..pro
72b0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
72c0: 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 {.. puts $s
72d0: 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 $p.. close $s
72e0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
72f0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
7300: 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 24 -myport $port $
7310: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
7320: 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 835]. set r [
7330: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f gets $s]. clo
7340: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
7350: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
7360: 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 cket9_2_test_ser
7370: 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 72 20 ver}. if {$r
7380: 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 65 74 == $port} {..set
7390: 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 20 7d result ok. }
73a0: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 else {..set res
73b0: 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 20 7d ult broken. }
73c0: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
73d0: 7d 20 6f 6b 0a 74 65 73 74 20 73 6f 63 6b 65 74 } ok.test socket
73e0: 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 6f -11.3 {trying to
73f0: 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 72 connect, no ser
7400: 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ver} {socket doT
7410: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
7420: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
7430: 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 status ok. if
7440: 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 {![catch {set s
7450: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 [tls::socket $r
7460: 65 6d 6f 74 65 53 65 72 76 65 72 49 70 20 32 38 emoteServerIp 28
7470: 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 36]}]} {..if {![
7480: 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 7d 5d catch {gets $s}]
7490: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 } {.. set sta
74a0: 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 tus broken..}..c
74b0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
74c0: 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f set status.} o
74d0: 6b 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 k.test socket-11
74e0: 2e 34 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c .4 {remote echo,
74f0: 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b one line} {sock
7500: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
7510: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
7520: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
7530: 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f .set socket10_6_
7540: 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 test_server [tls
7550: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
7560: 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 accept 2836]..p
7570: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
7580: 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 p} {.. fileev
7590: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
75a0: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
75b0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
75c0: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
75d0: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 e -translation c
75e0: 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 rlf..}..proc ech
75f0: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
7600: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
7610: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
7620: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
7630: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
7640: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
7650: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
7660: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 f [tls::socket $
7670: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
7680: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
7690: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
76a0: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
76b0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 ing line. put
76c0: 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 s $f hello. s
76d0: 65 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 et r [gets $f].
76e0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
76f0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
7700: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 se $socket10_6_t
7710: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
7720: 73 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 74 65 set r.} hello.te
7730: 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 35 20 7b st socket-11.5 {
7740: 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 remote echo, 50
7750: 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 lines} {socket d
7760: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
7770: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
7780: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
7790: 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 socket10_7_test
77a0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
77b0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
77c0: 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 ept 2836]..proc
77d0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
77e0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
77f0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
7800: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
7810: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
7820: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
7830: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
7840: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
7850: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
7860: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
7870: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
7880: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
7890: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
78a0: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
78b0: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
78c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
78d0: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d teServerIP 2836]
78e0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
78f0: 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $f -translation
7900: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
7910: 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 line. for {se
7920: 74 20 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c t cnt 0} {$cnt <
7930: 20 35 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 50} {incr cnt}
7940: 7b 0a 09 70 75 74 73 20 24 66 20 22 68 65 6c 6c {..puts $f "hell
7950: 6f 2c 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 o, $cnt"..if {[s
7960: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 tring compare [g
7970: 65 74 73 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 ets $f] "hello,
7980: 24 63 6e 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 $cnt"] != 0} {..
7990: 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 break..}.
79a0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
79b0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
79c0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
79d0: 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _7_test_server}.
79e0: 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 set cnt.} 50
79f0: 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 .# Macintosh soc
7a00: 6b 65 74 73 20 63 61 6e 20 68 61 76 65 20 6d 6f kets can have mo
7a10: 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 re than one serv
7a20: 65 72 20 70 65 72 20 70 6f 72 74 0a 69 66 20 7b er per port.if {
7a30: 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c $tcl_platform(pl
7a40: 61 74 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 69 atform) == "maci
7a50: 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 ntosh"} {. se
7a60: 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 t conflictResult
7a70: 20 7b 30 20 32 38 33 36 7d 0a 7d 20 65 6c 73 65 {0 2836}.} else
7a80: 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c {. set confl
7a90: 69 63 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f ictResult {1 {co
7aa0: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
7ab0: 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 et: address alre
7ac0: 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 74 ady in use}}.}.t
7ad0: 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 36 20 est socket-11.6
7ae0: 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 {socket conflict
7af0: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
7b00: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
7b10: 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 31 20 r} {. set s1
7b20: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
7b30: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
7b40: 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 ]. if {[catch
7b50: 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 {set s2 [tls::s
7b60: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
7b70: 63 65 70 74 20 32 38 33 36 5d 7d 20 6d 73 67 5d cept 2836]} msg]
7b80: 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 } {..set result
7b90: 5b 6c 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 [list 1 $msg].
7ba0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
7bb0: 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b result [list 0 [
7bc0: 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 lindex [fconfigu
7bd0: 72 65 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 re $s2 -sockname
7be0: 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 ] 2]]..close $s2
7bf0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
7c00: 20 24 73 31 0a 20 20 20 20 73 65 74 20 72 65 73 $s1. set res
7c10: 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 ult.} $conflictR
7c20: 65 73 75 6c 74 0a 74 65 73 74 20 73 6f 63 6b 65 esult.test socke
7c30: 74 2d 31 31 2e 37 20 7b 73 65 72 76 65 72 20 77 t-11.7 {server w
7c40: 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 ith several clie
7c50: 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 nts} {socket doT
7c60: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
7c70: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
7c80: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
7c90: 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 ocket10_9_test_s
7ca0: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
7cb0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
7cc0: 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 2836]..proc ac
7cd0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
7ce0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
7cf0: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
7d00: 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 e.. fileevent
7d10: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
7d20: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 st echo $s]..}..
7d30: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
7d40: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
7d50: 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 $s].. if {[e
7d60: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 of $s]} {...clos
7d70: 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 e $s.. } else
7d80: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a {...puts $s $l.
7d90: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
7da0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
7db0: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
7dc0: 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 erverIP 2836].
7dd0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 fconfigure $s1
7de0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
7df0: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
7e00: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
7e10: 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 ServerIP 2836].
7e20: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
7e30: 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 2 -buffering lin
7e40: 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c e. set s3 [tl
7e50: 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 s::socket $remot
7e60: 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a eServerIP 2836].
7e70: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
7e80: 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s3 -buffering li
7e90: 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 ne. for {set
7ea0: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
7eb0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 {incr i} {..puts
7ec0: 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 $s1 hello,s1..g
7ed0: 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 ets $s1..puts $s
7ee0: 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 2 hello,s2..gets
7ef0: 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 $s2..puts $s3 h
7f00: 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 ello,s3..gets $s
7f10: 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 3. }. clos
7f20: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
7f30: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
7f40: 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 3. sendComman
7f50: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
7f60: 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 10_9_test_server
7f70: 7d 0a 20 20 20 20 73 65 74 20 69 0a 7d 20 31 30 }. set i.} 10
7f80: 30 20 20 20 20 0a 74 65 73 74 20 73 6f 63 6b 65 0 .test socke
7f90: 74 2d 31 31 2e 38 20 7b 63 6c 69 65 6e 74 20 77 t-11.8 {client w
7fa0: 69 74 68 20 73 65 76 65 72 61 6c 20 73 65 72 76 ith several serv
7fb0: 65 72 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ers} {socket doT
7fc0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
7fd0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
7fe0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
7ff0: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 1 [tls::socket -
8000: 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 server "accept 4
8010: 30 30 33 22 20 34 30 30 33 5d 0a 09 73 65 74 20 003" 4003]..set
8020: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
8030: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
8040: 34 30 30 34 22 20 34 30 30 34 5d 0a 09 73 65 74 4004" 4004]..set
8050: 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s3 [tls::socket
8060: 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 -server "accept
8070: 20 34 30 30 35 22 20 34 30 30 35 5d 0a 09 70 72 4005" 4005]..pr
8080: 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 20 73 20 oc accept {mp s
8090: 61 20 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 a p} {.. puts
80a0: 20 24 73 20 24 6d 70 0a 09 20 20 20 20 63 6c 6f $s $mp.. clo
80b0: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
80c0: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
80d0: 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 socket $remoteSe
80e0: 72 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 20 rverIP 4003].
80f0: 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f set s2 [tls::so
8100: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
8110: 65 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 73 erIP 4004]. s
8120: 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s3 [tls::sock
8130: 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 et $remoteServer
8140: 49 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 74 IP 4005]. set
8150: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
8160: 64 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 5b d l [gets $s1] [
8170: 67 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 24 gets $s1] [eof $
8180: 73 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b s1] [gets $s2] [
8190: 67 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 24 gets $s2] [eof $
81a0: 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 33 s2] \..[gets $s3
81b0: 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 6f ] [gets $s3] [eo
81c0: 66 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 65 f $s3]. close
81d0: 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s1. close $
81e0: 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 s2. close $s3
81f0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8200: 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 63 {..close $s1..c
8210: 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 20 lose $s2..close
8220: 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s3. }. se
8230: 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 31 t l.} {4003 {} 1
8240: 20 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 20 4004 {} 1 4005
8250: 7b 7d 20 31 7d 0a 74 65 73 74 20 73 6f 63 6b 65 {} 1}.test socke
8260: 74 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 63 t-11.9 {accept c
8270: 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b allback error} {
8280: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8290: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
82a0: 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 {. set s [tls
82b0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
82c0: 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 20 20 accept 2836].
82d0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
82e0: 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f a p} {expr 10 /
82f0: 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 0}. proc bge
8300: 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f rror args {..glo
8310: 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 bal x..set x $ar
8320: 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 gs. }. if
8330: 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d {[catch {sendCom
8340: 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 20 mand {.. set
8350: 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 peername [fconfi
8360: 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b gure $callerSock
8370: 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 et -peername]..
8380: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8390: 6f 63 6b 65 74 20 5b 6c 69 6e 64 65 78 20 24 70 ocket [lindex $p
83a0: 65 65 72 6e 61 6d 65 20 30 5d 20 32 38 33 36 5d eername 0] 2836]
83b0: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 .. close $s.
83c0: 20 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a . }} msg]} {.
83d0: 09 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 .close $s..error
83e0: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
83f0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
8400: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
8410: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
8420: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
8430: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
8440: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 close $s. r
8450: 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d ename bgerror {}
8460: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 . set x.} {{d
8470: 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a ivide by zero}}.
8480: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 test socket-11.1
8490: 30 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 0 {testing socke
84a0: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
84b0: 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ns} {socket doTe
84c0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
84d0: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
84e0: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
84f0: 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 cket10_12_test_s
8500: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
8510: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
8520: 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 2836]..proc ac
8530: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c cept {s a p} {cl
8540: 6f 73 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 ose $s}. }.
8550: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
8560: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
8570: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 73 erIP 2836]. s
8580: 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 et p [fconfigure
8590: 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 $s -peername].
85a0: 20 20 20 73 65 74 20 6e 20 5b 66 63 6f 6e 66 69 set n [fconfi
85b0: 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d gure $s -socknam
85c0: 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a e]. set l "".
85d0: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
85e0: 69 6e 64 65 78 20 24 70 20 32 5d 20 5b 6c 6c 65 index $p 2] [lle
85f0: 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 ngth $p] [llengt
8600: 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f 73 65 20 h $p]. close
8610: 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 $s. sendComma
8620: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
8630: 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 t10_12_test_serv
8640: 65 72 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 er}. set l.}
8650: 7b 32 38 33 36 20 33 20 33 7d 0a 74 65 73 74 20 {2836 3 3}.test
8660: 73 6f 63 6b 65 74 2d 31 31 2e 31 31 20 7b 74 65 socket-11.11 {te
8670: 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 sting spurious e
8680: 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 vents} {socket d
8690: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
86a0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
86b0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
86c0: 20 73 6f 63 6b 65 74 31 30 5f 31 33 5f 74 65 73 socket10_13_tes
86d0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
86e0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
86f0: 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 cept 2836]..proc
8700: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
8710: 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 {.. fconfigur
8720: 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $s -translatio
8730: 6e 20 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 20 n "auto lf"..
8740: 20 61 66 74 65 72 20 31 30 30 20 77 72 69 74 65 after 100 write
8750: 73 6f 6d 65 20 24 73 0a 09 7d 0a 09 70 72 6f 63 some $s..}..proc
8760: 20 77 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b writesome {s} {
8770: 0a 09 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 .. for {set i
8780: 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 0} {$i < 100} {
8790: 69 6e 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 incr i} {...puts
87a0: 20 24 73 20 22 6c 69 6e 65 20 24 69 20 66 72 6f $s "line $i fro
87b0: 6d 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 22 m remote server"
87c0: 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f .. }.. clo
87d0: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
87e0: 20 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 set len 0.
87f0: 20 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a set spurious 0.
8800: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
8810: 20 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 proc readlitt
8820: 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c le {s} {..global
8830: 20 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c spurious done l
8840: 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 en..set l [read
8850: 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 $s 1]..if {[stri
8860: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d ng length $l] ==
8870: 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 0} {.. if {!
8880: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e [eof $s]} {...in
8890: 63 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 cr spurious..
88a0: 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 } else {...clos
88b0: 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 e $s...set done
88c0: 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 1.. }..} else
88d0: 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e {.. incr len
88e0: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 [string length
88f0: 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $l]..}. }.
8900: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
8910: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ket $remoteServe
8920: 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 69 rIP 2836]. fi
8930: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
8940: 62 6c 65 20 22 72 65 61 64 6c 69 74 74 6c 65 20 ble "readlittle
8950: 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c". set time
8960: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
8970: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
8980: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
8990: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
89a0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
89b0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
89c0: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 33 5f se $socket10_13_
89d0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
89e0: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
89f0: 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a $len.} {0 2690}.
8a00: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 test socket-11.1
8a10: 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 2 {testing EOF s
8a20: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 73 6f 63 6b tickyness} {sock
8a30: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
8a40: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
8a50: 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a set counter 0.
8a60: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
8a70: 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 proc count_up
8a80: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
8a90: 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 65 ounter done afte
8aa0: 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 r_id..set l [get
8ab0: 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 s $s]..if {[eof
8ac0: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 $s]} {.. incr
8ad0: 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 66 counter.. if
8ae0: 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 {$counter > 9}
8af0: 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f {...set done {EO
8b00: 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 F is sticky}...a
8b10: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 66 74 fter cancel $aft
8b20: 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 er_id...close $s
8b30: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
8b40: 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 64 5f . proc timed_
8b50: 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c out {} {..global
8b60: 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e c done..set don
8b70: 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f e {timed_out, EO
8b80: 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d F is not sticky}
8b90: 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d ..close $c. }
8ba0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8bb0: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
8bc0: 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 20 _14_test_server
8bd0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
8be0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
8bf0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
8c00: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 61 66 s a p} {.. af
8c10: 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 24 73 ter 100 close $s
8c20: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
8c30: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
8c40: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
8c50: 20 32 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 2836]. filee
8c60: 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 vent $c readable
8c70: 20 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a 20 "count_up $c".
8c80: 20 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 20 set after_id
8c90: 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 [after 1000 time
8ca0: 64 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 d_out]. vwait
8cb0: 20 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 6f done. sendCo
8cc0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
8cd0: 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 cket10_14_test_s
8ce0: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 64 erver}. set d
8cf0: 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 74 one.} {EOF is st
8d00: 69 63 6b 79 7d 0a 74 65 73 74 20 73 6f 63 6b 65 icky}.test socke
8d10: 74 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e 67 t-11.13 {testing
8d20: 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 73 async write, as
8d30: 79 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e 63 ync flush, async
8d40: 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 6b close} \..{sock
8d50: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
8d60: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
8d70: 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 proc readit {s
8d80: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e } {..global coun
8d90: 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 t done..set l [r
8da0: 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f ead $s]..incr co
8db0: 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 unt [string leng
8dc0: 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 th $l]..if {[eof
8dd0: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f $s]} {.. clo
8de0: 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 se $s.. set d
8df0: 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 one 1..}. }.
8e00: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
8e10: 0a 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b ..set firstblock
8e20: 20 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 ""..for {set i
8e30: 30 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 0} {$i < 5} {inc
8e40: 72 20 69 7d 20 7b 0a 09 09 73 65 74 20 66 69 72 r i} {...set fir
8e50: 73 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 stblock "a$first
8e60: 62 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b block$firstblock
8e70: 22 0a 09 7d 0a 09 73 65 74 20 73 65 63 6f 6e 64 "..}..set second
8e80: 62 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 block ""..for {s
8e90: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 et i 0} {$i < 16
8ea0: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 } {incr i} {..
8eb0: 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 set secondbloc
8ec0: 6b 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b k "b$secondblock
8ed0: 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 09 7d $secondblock"..}
8ee0: 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f ..set l [tls::so
8ef0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
8f00: 65 70 74 20 32 38 34 35 5d 0a 09 70 72 6f 63 20 ept 2845]..proc
8f10: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
8f20: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
8f30: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
8f40: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 -translation lf
8f50: 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 38 -buffersize 1638
8f60: 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 4 \...-buffering
8f70: 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 line.. filee
8f80: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
8f90: 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 09 "readable $s"..
8fa0: 7d 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c 65 }..proc readable
8fb0: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 {s} {.. set
8fc0: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 l [gets $s]..
8fd0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
8fe0: 61 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 61 adable {}.. a
8ff0: 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e fter 1000 respon
9000: 64 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 65 d $s..}..proc re
9010: 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 20 spond {s} {..
9020: 20 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f global firstblo
9030: 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e 6f ck.. puts -no
9040: 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 newline $s $firs
9050: 74 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 65 tblock.. afte
9060: 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 61 r 1000 writedata
9070: 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 $s..}..proc wri
9080: 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 20 tedata {s} {..
9090: 20 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 global secondb
90a0: 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d lock.. puts -
90b0: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 nonewline $s $se
90c0: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 63 condblock.. c
90d0: 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d lose $s..}. }
90e0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
90f0: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
9100: 65 72 76 65 72 49 50 20 32 38 34 35 5d 0a 20 20 erverIP 2845].
9110: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
9120: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 -blocking 0 -tra
9130: 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 ns lf -buffering
9140: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f line. set co
9150: 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 unt 0. puts $
9160: 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 s hello. file
9170: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
9180: 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 e "readit $s".
9190: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
91a0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f er 10000 "set do
91b0: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 ne timed_out"].
91c0: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
91d0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
91e0: 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f timer. sendCo
91f0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c 7d mmand {close $l}
9200: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d . set count.}
9210: 20 36 35 35 36 36 0a 0a 74 65 73 74 20 73 6f 63 65566..test soc
9220: 6b 65 74 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e ket-12.1 {testin
9230: 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 g inheritance of
9240: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 73 7d server sockets}
9250: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 \..{socket doTe
9260: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
9270: 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ver} {. remov
9280: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
9290: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
92a0: 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 ipt2.. # Scri
92b0: 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 pt1 is just a 10
92c0: 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 second delay.
92d0: 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 6f If the server so
92e0: 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e cket. # is in
92f0: 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c herited, it will
9300: 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f be held open fo
9310: 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 r 10 seconds..
9320: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
9330: 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 ript1 w]. put
9340: 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 s $f {..after 10
9350: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
9360: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
9370: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
9380: 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 65 # Script2 create
9390: 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 s the server soc
93a0: 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 63 ket, launches sc
93b0: 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 69 ript1,. # wai
93c0: 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e 64 ts a second, and
93d0: 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 72 exits. The ser
93e0: 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 ver socket will
93f0: 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c 6f now. # be clo
9400: 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 70 sed unless scrip
9410: 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 2e t1 inherited it.
9420: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
9430: 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 n script2 w].
9440: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
9450: 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 63 et tcltest $::tc
9460: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a ltest::tcltest].
9470: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
9480: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
9490: 63 6c 74 65 73 74 0a 09 73 65 74 20 66 20 5b 74 cltest..set f [t
94a0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
94b0: 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a er accept 2828].
94c0: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 .proc accept { f
94d0: 69 6c 65 20 61 64 64 72 20 70 6f 72 74 20 7d 20 ile addr port }
94e0: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 66 69 {.. close $fi
94f0: 6c 65 0a 09 7d 0a 09 65 78 65 63 20 24 3a 3a 74 le..}..exec $::t
9500: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
9510: 73 63 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 script1 &..close
9520: 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 $f..after 1000
9530: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
9540: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
9550: 6f 73 65 20 24 66 0a 09 0a 20 20 20 20 23 20 4c ose $f... # L
9560: 61 75 6e 63 68 20 73 63 72 69 70 74 32 20 61 6e aunch script2 an
9570: 64 20 77 61 69 74 20 35 20 73 65 63 6f 6e 64 73 d wait 5 seconds
9580: 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 .. exec $::tc
9590: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
95a0: 63 72 69 70 74 32 20 26 0a 20 20 20 20 61 66 74 cript2 &. aft
95b0: 65 72 20 35 30 30 30 20 7b 20 73 65 74 20 6f 6b er 5000 { set ok
95c0: 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 20 7d 0a _to_proceed 1 }.
95d0: 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f vwait ok_to_
95e0: 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 23 20 49 proceed.. # I
95f0: 66 20 77 65 20 63 61 6e 20 73 74 69 6c 6c 20 63 f we can still c
9600: 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 20 73 65 onnect to the se
9610: 72 76 65 72 2c 20 74 68 65 20 73 6f 63 6b 65 74 rver, the socket
9620: 20 67 6f 74 20 69 6e 68 65 72 69 74 65 64 2e 0a got inherited..
9630: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
9640: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 {tls::socket 127
9650: 2e 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 .0.0.1 2828} msg
9660: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 ]} {..set x {ser
9670: 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ver socket was n
9680: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 ot inherited}.
9690: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 } else {..clos
96a0: 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 e $msg..set x {s
96b0: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
96c0: 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 inherited}.
96d0: 7d 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c }.. removeFil
96e0: 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 e script1. re
96f0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 moveFile script2
9700: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 . set x.} {se
9710: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
9720: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 74 not inherited}.t
9730: 65 73 74 20 73 6f 63 6b 65 74 2d 31 32 2e 32 20 est socket-12.2
9740: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
9750: 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 ance of client s
9760: 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b ockets} \..{sock
9770: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
9780: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
9790: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
97a0: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
97b0: 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 ile script2..
97c0: 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 # Script1 is ju
97d0: 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 st a 10 second d
97e0: 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 elay. If the se
97f0: 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 rver socket.
9800: 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 # is inherited,
9810: 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 it will be held
9820: 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f open for 10 seco
9830: 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b nds.. set f [
9840: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
9850: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
9860: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
9870: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
9880: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
9890: 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 f.. # Script2
98a0: 20 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e opens the clien
98b0: 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 t socket and wri
98c0: 74 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 tes to it. It t
98d0: 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 hen. # launch
98e0: 65 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 es script1 and e
98f0: 78 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 xits. If the ch
9900: 69 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 ild process inhe
9910: 72 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 rited the. #
9920: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 client socket, t
9930: 68 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 he socket will s
9940: 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 till be open...
9950: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
9960: 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 cript2 w]. pu
9970: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
9980: 74 63 6c 74 65 73 74 20 24 3a 3a 74 63 6c 74 65 tcltest $::tclte
9990: 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 st::tcltest].
99a0: 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 puts $f {..set
99b0: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 f [tls::socket 1
99c0: 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 5d 0a 09 27.0.0.1 2829]..
99d0: 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a exec $::tcltest:
99e0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 :tcltest script1
99f0: 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 &..puts $f test
9a00: 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 ing..flush $f..a
9a10: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
9a20: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
9a30: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
9a40: 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 74 .. # Create t
9a50: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
9a60: 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 .. set server
9a70: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
9a80: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
9a90: 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 9]. proc acce
9aa0: 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 pt { file host p
9ab0: 6f 72 74 20 7d 20 7b 0a 0a 09 23 20 57 68 65 6e ort } {...# When
9ac0: 20 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e the client conn
9ad0: 65 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 20 ects, establish
9ae0: 74 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 72 the read handler
9af0: 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a ..global server.
9b00: 09 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a 09 .close $server..
9b10: 66 69 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 20 fileevent $file
9b20: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 readable [list g
9b30: 65 74 64 61 74 61 20 24 66 69 6c 65 5d 0a 09 66 etdata $file]..f
9b40: 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 configure $file
9b50: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
9b60: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 72 65 74 -blocking 0..ret
9b70: 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 urn. }. pr
9b80: 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 6c oc getdata { fil
9b90: 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 e } {...# Read h
9ba0: 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 andler on the ac
9bb0: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 09 cepted socket...
9bc0: 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c global x..global
9bd0: 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 failed..set sta
9be0: 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 tus [catch {read
9bf0: 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 $file} data]..i
9c00: 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d f {$status != 0}
9c10: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 {.. set x {r
9c20: 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f ead failed, erro
9c30: 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 r was $data}..
9c40: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
9c50: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 $file }..} elsei
9c60: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
9c70: 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a re {} $data]} {.
9c80: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f .} elseif {[fblo
9c90: 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 cked $file]} {..
9ca0: 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 } elseif {[eof $
9cb0: 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 file]} {.. if
9cc0: 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 {$failed} {...s
9cd0: 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 et x {client soc
9ce0: 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 ket was inherite
9cf0: 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b d}.. } else {
9d00: 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 ...set x {client
9d10: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
9d20: 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 inherited}..
9d30: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
9d40: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 lose $file }..}
9d50: 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 else {.. set
9d60: 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 x {impossible ca
9d70: 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b se}.. catch {
9d80: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
9d90: 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a }..return. }.
9da0: 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f . # If the so
9db0: 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 cket doesn't hit
9dc0: 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 end-of-file in
9dd0: 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 5 seconds, the.
9de0: 20 20 20 23 20 73 63 72 69 70 74 31 20 70 72 6f # script1 pro
9df0: 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 cess must have i
9e00: 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 nherited the cli
9e10: 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ent... set fa
9e20: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
9e30: 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 5000 [list set
9e40: 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 failed 1].. #
9e50: 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 Launch the scri
9e60: 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 pt2 process..
9e70: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
9e80: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
9e90: 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 2 &.. vwait x
9ea0: 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 . if {!$faile
9eb0: 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c d} {..vwait fail
9ec0: 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 6d ed. }. rem
9ed0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
9ee0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
9ef0: 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 cript2. set x
9f00: 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 .} {client socke
9f10: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
9f20: 74 65 64 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 ted}.test socket
9f30: 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 -12.3 {testing i
9f40: 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 63 nheritance of ac
9f50: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 cepted sockets}
9f60: 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 \..{socket doTes
9f70: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
9f80: 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 er} {. remove
9f90: 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 File script1.
9fa0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
9fb0: 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 5b pt2.. set f [
9fc0: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
9fd0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
9fe0: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
9ff0: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
a000: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
a010: 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 f.. set f [op
a020: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
a030: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
a040: 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 set tcltest $::t
a050: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d cltest::tcltest]
a060: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
a070: 73 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 3a set server [tls:
a080: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
a090: 61 63 63 65 70 74 20 32 39 33 30 5d 0a 09 70 72 accept 2930]..pr
a0a0: 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 oc accept { file
a0b0: 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 host port } {..
a0c0: 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 74 65 global tclte
a0d0: 73 74 0a 09 20 20 20 20 70 75 74 73 20 24 66 69 st.. puts $fi
a0e0: 6c 65 20 7b 74 65 73 74 20 64 61 74 61 20 6f 6e le {test data on
a0f0: 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 20 65 78 socket}.. ex
a100: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
a110: 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 20 26 cltest script1 &
a120: 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 .. after 1000
a130: 20 65 78 69 74 0a 09 7d 0a 09 76 77 61 69 74 20 exit..}..vwait
a140: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
a150: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
a160: 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 # Launch the scr
a170: 69 70 74 32 20 70 72 6f 63 65 73 73 20 61 6e 64 ipt2 process and
a180: 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e 20 connect to it.
a190: 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 20 See how long.
a1a0: 20 20 23 20 74 68 65 20 73 6f 63 6b 65 74 20 73 # the socket s
a1b0: 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 65 tays open.. e
a1c0: 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a xec $::tcltest::
a1d0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 20 tcltest script2
a1e0: 26 0a 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 &.. after 100
a1f0: 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 0 set ok_to_proc
a200: 65 65 64 20 31 0a 20 20 20 20 76 77 61 69 74 20 eed 1. vwait
a210: 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 ok_to_proceed..
a220: 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 set f [tls::s
a230: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
a240: 32 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2930]. fconfi
a250: 67 75 72 65 20 24 66 20 2d 62 75 66 66 65 72 69 gure $f -bufferi
a260: 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e ng full -blockin
a270: 67 20 30 0a 20 20 20 20 66 69 6c 65 65 76 65 6e g 0. fileeven
a280: 74 20 24 66 20 72 65 61 64 61 62 6c 65 20 5b 6c t $f readable [l
a290: 69 73 74 20 67 65 74 64 61 74 61 20 24 66 5d 0a ist getdata $f].
a2a0: 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f . # If the so
a2b0: 63 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 cket is still op
a2c0: 65 6e 20 61 66 74 65 72 20 35 20 73 65 63 6f 6e en after 5 secon
a2d0: 64 73 2c 20 74 68 65 20 73 63 72 69 70 74 31 20 ds, the script1
a2e0: 70 72 6f 63 65 73 73 0a 20 20 20 20 23 20 6d 75 process. # mu
a2f0: 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 st have inherite
a300: 64 20 74 68 65 20 61 63 63 65 70 74 65 64 20 73 d the accepted s
a310: 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 ocket... set
a320: 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 failed 0. aft
a330: 65 72 20 35 30 30 30 20 73 65 74 20 66 61 69 6c er 5000 set fail
a340: 65 64 20 31 0a 0a 20 20 20 20 70 72 6f 63 20 67 ed 1.. proc g
a350: 65 74 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 etdata { file }
a360: 7b 0a 0a 09 23 20 52 65 61 64 20 68 61 6e 64 6c {...# Read handl
a370: 65 72 20 6f 6e 20 74 68 65 20 63 6c 69 65 6e 74 er on the client
a380: 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c socket...global
a390: 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 x..global faile
a3a0: 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b 63 d..set status [c
a3b0: 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 atch {read $file
a3c0: 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 } data]..if {$st
a3d0: 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 atus != 0} {..
a3e0: 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 66 61 set x {read fa
a3f0: 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 iled, error was
a400: 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 74 63 $data}.. catc
a410: 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 h { close $file
a420: 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 }..} elseif {[st
a430: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 ring compare {}
a440: 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 $data]} {..} els
a450: 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 eif {[fblocked $
a460: 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 file]} {..} else
a470: 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d if {[eof $file]}
a480: 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 69 {.. if {$fai
a490: 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b led} {...set x {
a4a0: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 accepted socket
a4b0: 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 was inherited}..
a4c0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 } else {...s
a4d0: 65 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 73 et x {accepted s
a4e0: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
a4f0: 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a herited}.. }.
a500: 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f . catch { clo
a510: 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c se $file }..} el
a520: 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 se {.. set x
a530: 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 65 {impossible case
a540: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
a550: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a lose $file }..}.
a560: 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 .return. }.
a570: 20 20 0a 20 20 20 20 76 77 61 69 74 20 78 0a 0a . vwait x..
a580: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
a590: 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 cript1. remov
a5a0: 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 eFile script2.
a5b0: 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 70 set x.} {accep
a5c0: 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ted socket was n
a5d0: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 ot inherited}..t
a5e0: 65 73 74 20 73 6f 63 6b 65 74 2d 31 33 2e 31 20 est socket-13.1
a5f0: 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 20 {Testing use of
a600: 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 65 shared socket be
a610: 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 64 tween two thread
a620: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 s} \..{socket te
a630: 73 74 74 68 72 65 61 64 7d 20 7b 0a 0a 20 20 20 stthread} {..
a640: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
a650: 70 74 0a 20 20 20 20 74 68 72 65 61 64 52 65 61 pt. threadRea
a660: 70 0a 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 p.. makeFile
a670: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
a680: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
a690: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
a6a0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
a6b0: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
a6c0: 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 {s a p} {.
a6d0: 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 fileevent
a6e0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
a6f0: 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 st echo $s].
a700: 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 fconfigu
a710: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
a720: 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a line. }.
a730: 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b .proc echo {s} {
a740: 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a .. global i.
a750: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
a760: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
a770: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
a780: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
a790: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
a7a0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
a7b0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
a7c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
a7d0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
a7e0: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 } else {
a7f0: 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 .. incr
a800: 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
a810: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
a820: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a }..}.
a830: 09 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 20 .set i 0..vwait
a840: 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 x..close $f...#
a850: 74 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 74 thread cleans it
a860: 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 68 self up...testth
a870: 72 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d 20 read exit. }
a880: 73 63 72 69 70 74 0a 20 20 20 20 0a 20 20 20 20 script. .
a890: 23 20 63 72 65 61 74 65 20 61 20 74 68 72 65 61 # create a threa
a8a0: 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 d. set server
a8b0: 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 thread [testthre
a8c0: 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 ad create { sour
a8d0: 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 ce script } ].
a8e0: 20 20 75 70 64 61 74 65 0a 20 20 20 20 0a 20 20 update. .
a8f0: 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 after 1000.
a900: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
a910: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
a920: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
a930: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
a940: 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 line.. catch
a950: 20 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 6c {..puts $s "hel
a960: 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 73 lo"..gets $s res
a970: 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ult. }. cl
a980: 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 ose $s. updat
a990: 65 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 e.. after 200
a9a0: 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 0. lappend re
a9b0: 73 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 70 sult [threadReap
a9c0: 5d 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 72 ]. . set r
a9d0: 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 esult..} {hello
a9e0: 31 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 66 1}..# cleanup.if
a9f0: 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 {[string match
aa00: 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f sock* $commandSo
aa10: 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 cket] == 1} {.
aa20: 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f puts $commandSo
aa30: 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 6c 75 cket exit. flu
aa40: 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 sh $commandSocke
aa50: 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 t.}.catch {close
aa60: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d $commandSocket}
aa70: 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 72 .catch {close $r
aa80: 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a 3a emoteProcChan}.:
aa90: 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e 75 :tcltest::cleanu
aaa0: 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 74 64 pTests.flush std
aab0: 6f 75 74 0a 72 65 74 75 72 6e 0a 0a 0a 0a 0a 0a out.return......
aac0: 0a 0a 0a 0a 0a 0a ......