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 32 30 30 30 20 41 6a 75 62 61 20 53 6f 98-2000 Ajuba So
0150: 6c 75 74 69 6f 6e 73 2e 20 0a 23 0a 23 20 53 65 lutions. .#.# Se
0160: 65 20 74 68 65 20 66 69 6c 65 20 22 6c 69 63 65 e the file "lice
0170: 6e 73 65 2e 74 65 72 6d 73 22 20 66 6f 72 20 69 nse.terms" for i
0180: 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f 6e 20 75 73 nformation on us
0190: 61 67 65 20 61 6e 64 20 72 65 64 69 73 74 72 69 age and redistri
01a0: 62 75 74 69 6f 6e 0a 23 20 6f 66 20 74 68 69 73 bution.# of this
01b0: 20 66 69 6c 65 2c 20 61 6e 64 20 66 6f 72 20 61 file, and for a
01c0: 20 44 49 53 43 4c 41 49 4d 45 52 20 4f 46 20 41 DISCLAIMER OF A
01d0: 4c 4c 20 57 41 52 52 41 4e 54 49 45 53 2e 0a 23 LL WARRANTIES..#
01e0: 0a 23 20 52 43 53 3a 20 40 28 23 29 20 24 49 64 .# RCS: @(#) $Id
01f0: 3a 20 74 6c 73 49 6f 2e 74 65 73 74 2c 76 20 31 : tlsIo.test,v 1
0200: 2e 36 20 32 30 30 30 2f 30 36 2f 30 32 20 32 32 .6 2000/06/02 22
0210: 3a 32 36 3a 31 32 20 61 77 62 20 45 78 70 20 24 :26:12 awb Exp $
0220: 0a 0a 23 20 52 75 6e 6e 69 6e 67 20 73 6f 63 6b ..# Running sock
0230: 65 74 20 74 65 73 74 73 20 77 69 74 68 20 61 20 et tests with a
0240: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 3a 0a 23 remote server:.#
0250: 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ---------------
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 0a 23 20 0a 23 -----------.# .#
0280: 20 53 6f 6d 65 20 74 65 73 74 73 20 69 6e 20 73 Some tests in s
0290: 6f 63 6b 65 74 2e 74 65 73 74 20 64 65 70 65 6e ocket.test depen
02a0: 64 20 6f 6e 20 74 68 65 20 65 78 69 73 74 65 6e d on the existen
02b0: 63 65 20 6f 66 20 61 20 72 65 6d 6f 74 65 20 73 ce of a remote s
02c0: 65 72 76 65 72 20 74 6f 0a 23 20 77 68 69 63 68 erver to.# which
02d0: 20 74 68 65 79 20 63 6f 6e 6e 65 63 74 2e 20 54 they connect. T
02e0: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
02f0: 20 6d 75 73 74 20 62 65 20 61 6e 20 69 6e 73 74 must be an inst
0300: 61 6e 63 65 20 6f 66 20 74 63 6c 74 65 73 74 20 ance of tcltest
0310: 61 6e 64 20 69 74 0a 23 20 6d 75 73 74 20 72 75 and it.# must ru
0320: 6e 20 74 68 65 20 73 63 72 69 70 74 20 66 6f 75 n the script fou
0330: 6e 64 20 69 6e 20 74 68 65 20 66 69 6c 65 20 22 nd in the file "
0340: 72 65 6d 6f 74 65 2e 74 63 6c 22 20 69 6e 20 74 remote.tcl" in t
0350: 68 69 73 20 64 69 72 65 63 74 6f 72 79 2e 20 59 his directory. Y
0360: 6f 75 0a 23 20 63 61 6e 20 73 74 61 72 74 20 74 ou.# can start t
0370: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
0380: 20 6f 6e 20 61 6e 79 20 6d 61 63 68 69 6e 65 20 on any machine
0390: 72 65 61 63 68 61 62 6c 65 20 66 72 6f 6d 20 74 reachable from t
03a0: 68 65 20 6d 61 63 68 69 6e 65 20 6f 6e 0a 23 20 he machine on.#
03b0: 77 68 69 63 68 20 79 6f 75 20 77 61 6e 74 20 74 which you want t
03c0: 6f 20 72 75 6e 20 74 68 65 20 73 6f 63 6b 65 74 o run the socket
03d0: 20 74 65 73 74 73 2c 20 62 79 20 69 73 73 75 69 tests, by issui
03e0: 6e 67 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c ng:.# .# tcl
03f0: 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 test remote.tcl
0400: 2d 70 6f 72 74 20 32 30 34 38 09 23 20 4f 72 20 -port 2048.# Or
0410: 63 68 6f 6f 73 65 20 61 6e 6f 74 68 65 72 20 70 choose another p
0420: 6f 72 74 20 6e 75 6d 62 65 72 2e 0a 23 20 0a 23 ort number..# .#
0430: 20 49 66 20 74 68 65 20 6d 61 63 68 69 6e 65 20 If the machine
0440: 79 6f 75 20 61 72 65 20 72 75 6e 6e 69 6e 67 20 you are running
0450: 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 the remote serve
0460: 72 20 6f 6e 20 68 61 73 20 73 65 76 65 72 61 6c r on has several
0470: 20 49 50 0a 23 20 69 6e 74 65 72 66 61 63 65 73 IP.# interfaces
0480: 2c 20 79 6f 75 20 63 61 6e 20 63 68 6f 6f 73 65 , you can choose
0490: 20 77 68 69 63 68 20 69 6e 74 65 72 66 61 63 65 which interface
04a0: 20 74 68 65 20 73 65 72 76 65 72 20 6c 69 73 74 the server list
04b0: 65 6e 73 20 6f 6e 20 66 6f 72 0a 23 20 63 6f 6e ens on for.# con
04c0: 6e 65 63 74 69 6f 6e 73 20 62 79 20 73 70 65 63 nections by spec
04d0: 69 66 79 69 6e 67 20 74 68 65 20 2d 61 64 64 72 ifying the -addr
04e0: 65 73 73 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e 65 ess command line
04f0: 20 66 6c 61 67 2c 20 73 6f 3a 0a 23 20 0a 23 20 flag, so:.# .#
0500: 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f tcltest remo
0510: 74 65 2e 74 63 6c 20 2d 61 64 64 72 65 73 73 20 te.tcl -address
0520: 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d your.machine.com
0530: 0a 23 20 0a 23 20 54 68 65 73 65 20 6f 70 74 69 .# .# These opti
0540: 6f 6e 73 20 63 61 6e 20 61 6c 73 6f 20 62 65 20 ons can also be
0550: 73 65 74 20 62 79 20 65 6e 76 69 72 6f 6e 6d 65 set by environme
0560: 6e 74 20 76 61 72 69 61 62 6c 65 73 2e 20 4f 6e nt variables. On
0570: 20 55 6e 69 78 2c 20 79 6f 75 20 63 61 6e 0a 23 Unix, you can.#
0580: 20 74 79 70 65 20 74 68 65 73 65 20 63 6f 6d 6d type these comm
0590: 61 6e 64 73 20 74 6f 20 74 68 65 20 73 68 65 6c ands to the shel
05a0: 6c 20 66 72 6f 6d 20 77 68 69 63 68 20 74 68 65 l from which the
05b0: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 69 remote server i
05c0: 73 20 73 74 61 72 74 65 64 3a 0a 23 20 0a 23 20 s started:.# .#
05d0: 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e shell% seten
05e0: 76 20 73 65 72 76 65 72 50 6f 72 74 20 32 30 34 v serverPort 204
05f0: 38 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 8.# shell% s
0600: 65 74 65 6e 76 20 73 65 72 76 65 72 41 64 64 72 etenv serverAddr
0610: 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 ess your.machine
0620: 2e 63 6f 6d 0a 23 20 0a 23 20 61 6e 64 20 73 75 .com.# .# and su
0630: 62 73 65 71 75 65 6e 74 6c 79 20 79 6f 75 20 63 bsequently you c
0640: 61 6e 20 73 74 61 72 74 20 74 68 65 20 72 65 6d an start the rem
0650: 6f 74 65 20 73 65 72 76 65 72 20 77 69 74 68 3a ote server with:
0660: 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 65 73 .# .# tcltes
0670: 74 20 72 65 6d 6f 74 65 2e 74 63 6c 0a 23 20 0a t remote.tcl.# .
0680: 23 20 74 6f 20 68 61 76 65 20 69 74 20 6c 69 73 # to have it lis
0690: 74 65 6e 20 6f 6e 20 70 6f 72 74 20 32 30 34 38 ten on port 2048
06a0: 20 6f 6e 20 74 68 65 20 69 6e 74 65 72 66 61 63 on the interfac
06b0: 65 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 e your.machine.c
06c0: 6f 6d 2e 0a 23 20 20 20 20 20 0a 23 20 57 68 65 om..# .# Whe
06d0: 6e 20 74 68 65 20 73 65 72 76 65 72 20 73 74 61 n the server sta
06e0: 72 74 73 2c 20 69 74 20 70 72 69 6e 74 73 20 6f rts, it prints o
06f0: 75 74 20 61 20 64 65 74 61 69 6c 65 64 20 6d 65 ut a detailed me
0700: 73 73 61 67 65 20 63 6f 6e 74 61 69 6e 69 6e 67 ssage containing
0710: 20 69 74 73 0a 23 20 63 6f 6e 66 69 67 75 72 61 its.# configura
0720: 74 69 6f 6e 20 69 6e 66 6f 72 6d 61 74 69 6f 6e tion information
0730: 2c 20 61 6e 64 20 69 74 20 77 69 6c 6c 20 62 6c , and it will bl
0740: 6f 63 6b 20 75 6e 74 69 6c 20 6b 69 6c 6c 65 64 ock until killed
0750: 20 77 69 74 68 20 61 20 43 74 72 6c 2d 43 2e 0a with a Ctrl-C..
0760: 23 20 4f 6e 63 65 20 74 68 65 20 72 65 6d 6f 74 # Once the remot
0770: 65 20 73 65 72 76 65 72 20 65 78 69 73 74 73 2c e server exists,
0780: 20 79 6f 75 20 63 61 6e 20 72 75 6e 20 74 68 65 you can run the
0790: 20 74 65 73 74 73 20 69 6e 20 73 6f 63 6b 65 74 tests in socket
07a0: 2e 74 65 73 74 20 77 69 74 68 0a 23 20 74 68 65 .test with.# the
07b0: 20 73 65 72 76 65 72 20 62 79 20 73 65 74 74 69 server by setti
07c0: 6e 67 20 74 77 6f 20 54 63 6c 20 76 61 72 69 61 ng two Tcl varia
07d0: 62 6c 65 73 3a 0a 23 20 0a 23 20 20 20 20 20 25 bles:.# .# %
07e0: 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 set remoteServe
07f0: 72 49 50 20 3c 6e 61 6d 65 20 6f 72 20 61 64 64 rIP <name or add
0800: 72 65 73 73 20 6f 66 20 6d 61 63 68 69 6e 65 20 ress of machine
0810: 6f 6e 20 77 68 69 63 68 20 73 65 72 76 65 72 20 on which server
0820: 72 75 6e 73 3e 0a 23 20 20 20 20 20 25 20 73 65 runs>.# % se
0830: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
0840: 72 74 20 32 30 34 38 0a 23 20 0a 23 20 54 68 65 rt 2048.# .# The
0850: 73 65 20 76 61 72 69 61 62 6c 65 73 20 61 72 65 se variables are
0860: 20 61 6c 73 6f 20 73 65 74 74 61 62 6c 65 20 66 also settable f
0870: 72 6f 6d 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d rom the environm
0880: 65 6e 74 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 6f ent. On Unix, yo
0890: 75 20 63 61 6e 3a 0a 23 20 0a 23 20 20 20 20 20 u can:.# .#
08a0: 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 72 65 shell% setenv re
08b0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 6d 61 63 moteServerIP mac
08c0: 68 69 6e 65 2e 77 68 65 72 65 2e 73 65 72 76 65 hine.where.serve
08d0: 72 2e 72 75 6e 73 0a 23 20 20 20 20 20 73 68 65 r.runs.# she
08e0: 6c 6c 25 20 73 65 6e 65 74 76 20 72 65 6d 6f 74 ll% senetv remot
08f0: 65 53 65 72 76 65 72 50 6f 72 74 20 32 30 34 38 eServerPort 2048
0900: 0a 23 20 0a 23 20 54 68 65 20 70 72 65 61 6d 62 .# .# The preamb
0910: 6c 65 20 6f 66 20 74 68 65 20 73 6f 63 6b 65 74 le of the socket
0920: 2e 74 65 73 74 20 66 69 6c 65 20 63 68 65 63 6b .test file check
0930: 73 20 74 6f 20 73 65 65 20 69 66 20 74 68 65 20 s to see if the
0940: 76 61 72 69 61 62 6c 65 73 20 61 72 65 20 73 65 variables are se
0950: 74 0a 23 20 65 69 74 68 65 72 20 69 6e 20 54 63 t.# either in Tc
0960: 6c 20 6f 72 20 69 6e 20 74 68 65 20 65 6e 76 69 l or in the envi
0970: 72 6f 6e 6d 65 6e 74 3b 20 69 66 20 74 68 65 79 ronment; if they
0980: 20 61 72 65 2c 20 69 74 20 61 74 74 65 6d 70 74 are, it attempt
0990: 73 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f 0a s to connect to.
09a0: 23 20 74 68 65 20 73 65 72 76 65 72 2e 20 49 66 # the server. If
09b0: 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 the connection
09c0: 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c 20 74 is successful, t
09d0: 68 65 20 74 65 73 74 73 20 75 73 69 6e 67 20 74 he tests using t
09e0: 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 he remote.# serv
09f0: 65 72 20 77 69 6c 6c 20 62 65 20 70 65 72 66 6f er will be perfo
0a00: 72 6d 65 64 3b 20 6f 74 68 65 72 77 69 73 65 2c rmed; otherwise,
0a10: 20 69 74 20 77 69 6c 6c 20 61 74 74 65 6d 70 74 it will attempt
0a20: 20 74 6f 20 73 74 61 72 74 20 74 68 65 20 72 65 to start the re
0a30: 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 20 28 76 mote.# server (v
0a40: 69 61 20 65 78 65 63 29 20 6f 6e 20 70 6c 61 74 ia exec) on plat
0a50: 66 6f 72 6d 73 20 74 68 61 74 20 73 75 70 70 6f forms that suppo
0a60: 72 74 20 74 68 69 73 2c 20 6f 6e 20 74 68 65 20 rt this, on the
0a70: 6c 6f 63 61 6c 20 68 6f 73 74 2c 0a 23 20 6c 69 local host,.# li
0a80: 73 74 65 6e 69 6e 67 20 61 74 20 70 6f 72 74 20 stening at port
0a90: 32 30 34 38 2e 20 49 66 20 61 6c 6c 20 66 61 69 2048. If all fai
0aa0: 6c 73 2c 20 61 20 6d 65 73 73 61 67 65 20 69 73 ls, a message is
0ab0: 20 70 72 69 6e 74 65 64 20 61 6e 64 20 74 68 65 printed and the
0ac0: 20 74 65 73 74 73 0a 23 20 75 73 69 6e 67 20 74 tests.# using t
0ad0: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
0ae0: 20 61 72 65 20 6e 6f 74 20 70 65 72 66 6f 72 6d are not perform
0af0: 65 64 2e 0a 0a 69 66 20 7b 5b 6c 73 65 61 72 63 ed...if {[lsearc
0b00: 68 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 68 69 h [namespace chi
0b10: 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c 74 65 73 74 ldren] ::tcltest
0b20: 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 70 ] == -1} {. p
0b30: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
0b40: 63 6c 74 65 73 74 0a 20 20 20 20 6e 61 6d 65 73 cltest. names
0b50: 70 61 63 65 20 69 6d 70 6f 72 74 20 2d 66 6f 72 pace import -for
0b60: 63 65 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 2a 0a ce ::tcltest::*.
0b70: 7d 0a 0a 23 20 4c 6f 61 64 20 74 68 65 20 74 6c }..# Load the tl
0b80: 73 20 70 61 63 6b 61 67 65 0a 70 61 63 6b 61 67 s package.packag
0b90: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 0a 73 e require tls..s
0ba0: 65 74 20 73 65 72 76 65 72 43 65 72 74 20 5b 66 et serverCert [f
0bb0: 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 63 6c 74 ile join $::tclt
0bc0: 65 73 74 3a 3a 74 65 73 74 73 44 69 72 65 63 74 est::testsDirect
0bd0: 6f 72 79 20 63 65 72 74 73 20 73 65 72 76 65 72 ory certs server
0be0: 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e 74 .pem].set client
0bf0: 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 Cert [file join
0c00: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 $::tcltest::test
0c10: 73 44 69 72 65 63 74 6f 72 79 20 63 65 72 74 73 sDirectory certs
0c20: 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 65 74 client.pem].set
0c30: 20 63 61 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f caCert [file jo
0c40: 69 6e 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 in $::tcltest::t
0c50: 65 73 74 73 44 69 72 65 63 74 6f 72 79 20 63 65 estsDirectory ce
0c60: 72 74 73 20 63 61 63 65 72 74 2e 70 65 6d 5d 0a rts cacert.pem].
0c70: 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 5b 66 set serverKey [f
0c80: 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 63 6c 74 ile join $::tclt
0c90: 65 73 74 3a 3a 74 65 73 74 73 44 69 72 65 63 74 est::testsDirect
0ca0: 6f 72 79 20 63 65 72 74 73 20 73 6b 65 79 2e 70 ory certs skey.p
0cb0: 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e 74 4b 65 em].set clientKe
0cc0: 79 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a y [file join $::
0cd0: 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 73 44 69 tcltest::testsDi
0ce0: 72 65 63 74 6f 72 79 20 63 65 72 74 73 20 63 6b rectory certs ck
0cf0: 65 79 2e 70 65 6d 5d 0a 0a 23 20 53 6f 6d 65 20 ey.pem]..# Some
0d00: 74 65 73 74 73 20 72 65 71 75 69 72 65 20 74 68 tests require th
0d10: 65 20 74 65 73 74 74 68 72 65 61 64 20 63 6f 6d e testthread com
0d20: 6d 61 6e 64 0a 0a 73 65 74 20 3a 3a 74 63 6c 74 mand..set ::tclt
0d30: 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 est::testConstra
0d40: 69 6e 74 73 28 74 65 73 74 74 68 72 65 61 64 29 ints(testthread)
0d50: 20 5c 0a 09 5b 65 78 70 72 20 7b 5b 69 6e 66 6f \..[expr {[info
0d60: 20 63 6f 6d 6d 61 6e 64 73 20 74 65 73 74 74 68 commands testth
0d70: 72 65 61 64 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 read] != {}}]..#
0d80: 0a 23 20 49 66 20 72 65 6d 6f 74 65 53 65 72 76 .# If remoteServ
0d90: 65 72 49 50 20 6f 72 20 72 65 6d 6f 74 65 53 65 erIP or remoteSe
0da0: 72 76 65 72 50 6f 72 74 20 61 72 65 20 6e 6f 74 rverPort are not
0db0: 20 73 65 74 2c 20 63 68 65 63 6b 20 69 6e 20 74 set, check in t
0dc0: 68 65 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 he.# environment
0dd0: 20 76 61 72 69 61 62 6c 65 73 20 66 6f 72 20 65 variables for e
0de0: 78 74 65 72 6e 61 6c 6c 79 20 73 65 74 20 76 61 xternally set va
0df0: 6c 75 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b 69 lues..#..if {![i
0e00: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 nfo exists remot
0e10: 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a 20 20 eServerIP]} {.
0e20: 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 if {[info exis
0e30: 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 ts env(remoteSer
0e40: 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 verIP)]} {..set
0e50: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 remoteServerIP $
0e60: 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 env(remoteServer
0e70: 49 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b IP). }.}.if {
0e80: 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 ![info exists re
0e90: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d moteServerPort]}
0ea0: 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f {. if {[info
0eb0: 20 65 78 69 73 74 73 20 65 6e 76 28 72 65 6d 6f exists env(remo
0ec0: 74 65 53 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a teServerIP)]} {.
0ed0: 09 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 .set remoteServe
0ee0: 72 50 6f 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 rPort $env(remot
0ef0: 65 53 65 72 76 65 72 50 6f 72 74 29 0a 20 20 20 eServerPort).
0f00: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
0f10: 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 if {[info exis
0f20: 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 ts remoteServerI
0f30: 50 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 72 P]} {.. set r
0f40: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 emoteServerPort
0f50: 32 30 34 38 0a 20 20 20 20 20 20 20 20 7d 0a 20 2048. }.
0f60: 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 }.}..#.# Chec
0f70: 6b 20 69 66 20 77 65 27 72 65 20 73 75 70 70 6f k if we're suppo
0f80: 73 65 64 20 74 6f 20 64 6f 20 74 65 73 74 73 20 sed to do tests
0f90: 61 67 61 69 6e 73 74 20 74 68 65 20 72 65 6d 6f against the remo
0fa0: 74 65 20 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 te server.#..set
0fb0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
0fc0: 74 65 53 65 72 76 65 72 20 31 0a 69 66 20 7b 21 teServer 1.if {!
0fd0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
0fe0: 6f 74 65 53 65 72 76 65 72 49 50 5d 20 26 26 20 oteServerIP] &&
0ff0: 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 ($tcl_platform(p
1000: 6c 61 74 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 latform) != "mac
1010: 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 intosh")} {.
1020: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
1030: 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 IP 127.0.0.1.}.i
1040: 66 20 7b 28 24 64 6f 54 65 73 74 73 57 69 74 68 f {($doTestsWith
1050: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 RemoteServer ==
1060: 31 29 20 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 1) && (![info ex
1070: 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 ists remoteServe
1080: 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 rPort])} {. s
1090: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 et remoteServerP
10a0: 6f 72 74 20 32 30 34 38 0a 7d 0a 0a 23 20 41 74 ort 2048.}..# At
10b0: 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 tempt to connect
10c0: 20 74 6f 20 61 20 72 65 6d 6f 74 65 20 73 65 72 to a remote ser
10d0: 76 65 72 20 69 66 20 6f 6e 65 20 69 73 20 61 6c ver if one is al
10e0: 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 ready running. I
10f0: 66 20 69 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 f it.# is not ru
1100: 6e 6e 69 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d nning or for som
1110: 65 20 6f 74 68 65 72 20 72 65 61 73 6f 6e 20 74 e other reason t
1120: 68 65 20 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 he connect fails
1130: 2c 20 61 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 , attempt to.# s
1140: 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 20 tart the remote
1150: 73 65 72 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f server on the lo
1160: 63 61 6c 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 cal host listeni
1170: 6e 67 20 6f 6e 20 70 6f 72 74 20 32 30 34 38 2e ng on port 2048.
1180: 20 54 68 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 This.# is only
1190: 64 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d done on platform
11a0: 73 20 74 68 61 74 20 73 75 70 70 6f 72 74 20 65 s that support e
11b0: 78 65 63 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e xec (i.e. not on
11c0: 20 74 68 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 the Mac). On.#
11d0: 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 20 64 platforms that d
11e0: 6f 20 6e 6f 74 20 73 75 70 70 6f 72 74 20 65 78 o not support ex
11f0: 65 63 2c 20 74 68 65 20 72 65 6d 6f 74 65 20 73 ec, the remote s
1200: 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 73 74 erver must be st
1210: 61 72 74 65 64 0a 23 20 62 79 20 74 68 65 20 75 arted.# by the u
1220: 73 65 72 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 ser before runni
1230: 6e 67 20 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 ng the tests...s
1240: 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 et remoteProcCha
1250: 6e 20 22 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 n "".set command
1260: 53 6f 63 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 Socket "".if {$d
1270: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
1280: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 Server} {. ca
1290: 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d tch {close $comm
12a0: 61 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 andSocket}. i
12b0: 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 f {[catch {set c
12c0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c ommandSocket [tl
12d0: 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 s::socket $remot
12e0: 65 53 65 72 76 65 72 49 50 20 5c 0a 09 09 09 09 eServerIP \.....
12f0: 09 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 ..$remoteServerP
1300: 6f 72 74 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 ort]}] != 0} {..
1310: 69 66 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e if {[info comman
1320: 64 73 20 65 78 65 63 5d 20 3d 3d 20 22 22 7d 20 ds exec] == ""}
1330: 7b 0a 09 20 20 20 20 73 65 74 20 6e 6f 52 65 6d {.. set noRem
1340: 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 22 63 oteTestReason "c
1350: 61 6e 27 74 20 65 78 65 63 22 0a 09 20 20 20 20 an't exec"..
1360: 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 set doTestsWithR
1370: 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 7d emoteServer 0..}
1380: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 else {.. set
1390: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
13a0: 31 32 37 2e 30 2e 30 2e 31 0a 09 20 20 20 20 73 127.0.0.1.. s
13b0: 65 74 20 72 65 6d 6f 74 65 46 69 6c 65 20 5b 66 et remoteFile [f
13c0: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 ile join [pwd] r
13d0: 65 6d 6f 74 65 2e 74 63 6c 5d 0a 09 20 20 20 20 emote.tcl]..
13e0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 if {[catch {set
13f0: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 5c remoteProcChan \
1400: 0a 09 09 09 09 5b 6f 70 65 6e 20 22 7c 5b 6c 69 .....[open "|[li
1410: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
1420: 63 6c 74 65 73 74 20 24 72 65 6d 6f 74 65 46 69 cltest $remoteFi
1430: 6c 65 20 5c 0a 09 09 09 09 09 2d 73 65 72 76 65 le \......-serve
1440: 72 49 73 53 69 6c 65 6e 74 20 5c 0a 09 09 09 09 rIsSilent \.....
1450: 09 2d 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 .-port $remoteSe
1460: 72 76 65 72 50 6f 72 74 20 5c 0a 09 09 09 09 09 rverPort \......
1470: 2d 61 64 64 72 65 73 73 20 24 72 65 6d 6f 74 65 -address $remote
1480: 53 65 72 76 65 72 49 50 5d 22 20 5c 0a 09 09 09 ServerIP]" \....
1490: 09 09 77 2b 5d 7d 20 5c 0a 09 09 20 20 20 6d 73 ..w+]} \... ms
14a0: 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 61 66 74 g] == 0} {...aft
14b0: 65 72 20 31 30 30 30 0a 09 09 69 66 20 7b 5b 63 er 1000...if {[c
14c0: 61 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d 61 6e atch {set comman
14d0: 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f dSocket [tls::so
14e0: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
14f0: 65 72 49 50 20 5c 0a 09 09 09 09 24 72 65 6d 6f erIP \.....$remo
1500: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d teServerPort]} m
1510: 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 sg] == 0} {...
1520: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f fconfigure $co
1530: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 mmandSocket -tra
1540: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 nslation crlf -b
1550: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 uffering line...
1560: 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 } else {... s
1570: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1580: 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 eason $msg...
1590: 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 set doTestsWith
15a0: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 RemoteServer 0..
15b0: 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b .}.. } else {
15c0: 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 ...set noRemoteT
15d0: 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 estReason "$msg
15e0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
15f0: 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54 65 73 est"...set doTes
1600: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
1610: 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 er 0.. }..}.
1620: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f } else {..fco
1630: 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 nfigure $command
1640: 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 Socket -translat
1650: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
1660: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d ing line. }.}
1670: 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 61 ..# Some tests a
1680: 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 re run only if w
1690: 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65 73 74 e are doing test
16a0: 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20 72 65 ing against a re
16b0: 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 65 74 mote server..set
16c0: 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 ::tcltest::test
16d0: 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 65 Constraints(doTe
16e0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
16f0: 76 65 72 29 20 24 64 6f 54 65 73 74 73 57 69 74 ver) $doTestsWit
1700: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 hRemoteServer.if
1710: 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 {$doTestsWithRe
1720: 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 30 7d moteServer == 0}
1730: 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 {. if {[stri
1740: 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a 74 63 ng first s $::tc
1750: 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 ltest::verbose]
1760: 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 != -1} {. .pu
1770: 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74 65 73 ts "Skipping tes
1780: 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65 20 73 ts with remote s
1790: 65 72 76 65 72 2e 20 53 65 65 20 74 65 73 74 73 erver. See tests
17a0: 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 /socket.test for
17b0: 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 "..puts "informa
17c0: 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 tion on how to r
17d0: 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 un remote server
17e0: 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73 6f 6e ."..puts "Reason
17f0: 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 for not doing r
1800: 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 6e 6f emote tests: $no
1810: 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e RemoteTestReason
1820: 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 ". }.}..#.# I
1830: 66 20 77 65 20 64 6f 20 74 68 65 20 74 65 73 74 f we do the test
1840: 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d s, define a comm
1850: 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 63 6f and to send a co
1860: 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 mmand to the.# r
1870: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 0a emote server..#.
1880: 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 .if {$doTestsWit
1890: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d hRemoteServer ==
18a0: 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 1} {. proc s
18b0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b endCommand {c} {
18c0: 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 ..global command
18d0: 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f Socket...if {[eo
18e0: 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 f $commandSocket
18f0: 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 ]} {.. error
1900: 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 "remote server d
1910: 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a isappeared"..}..
1920: 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 .if {[catch {put
1930: 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 s $commandSocket
1940: 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 $c} msg]} {..
1950: 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 error "remote
1960: 73 65 72 76 65 72 20 64 69 73 61 70 70 61 65 72 server disappaer
1970: 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 ed: $msg"..}..if
1980: 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 {[catch {puts $
1990: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d commandSocket "-
19a0: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
19b0: 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d -Marker--"} msg]
19c0: 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 } {.. error "
19d0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 remote server di
19e0: 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 sappeared: $msg"
19f0: 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 22 ..}...set resp "
1a00: 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 "..while {1} {..
1a10: 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 set line [ge
1a20: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
1a30: 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 t].. if {[eof
1a40: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
1a50: 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 6d } {...error "rem
1a60: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
1a70: 70 61 65 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 paered".. }..
1a80: 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 if {[string
1a90: 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 2d compare $line "-
1aa0: 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d -Marker--Marker-
1ab0: 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 -Marker--"] == 0
1ac0: 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e } {...if {[strin
1ad0: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
1ae0: 78 20 24 72 65 73 70 20 30 5d 20 65 72 72 6f 72 x $resp 0] error
1af0: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 ] == 0} {...
1b00: 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 error [lindex $r
1b10: 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 esp 1]...} else
1b20: 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b {... return [
1b30: 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a lindex $resp 1].
1b40: 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ..}.. } else
1b50: 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 {...append resp
1b60: 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 $line "\n"..
1b70: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 }..}. }.}..te
1b80: 73 74 20 73 6f 63 6b 65 74 2d 31 2e 31 20 7b 61 st socket-1.1 {a
1b90: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
1ba0: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
1bb0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
1bc0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
1bd0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 socket -server}
1be0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
1bf0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
1c00: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
1c10: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d cket -server com
1c20: 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 mand ?options? p
1c30: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 ort"}}..test soc
1c40: 6b 65 74 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 ket-1.2 {arg par
1c50: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
1c60: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
1c70: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
1c80: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
1c90: 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 -server foo} ms
1ca0: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
1cb0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
1cc0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
1cd0: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
1ce0: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
1cf0: 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 t"}}..test socke
1d00: 74 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 t-1.3 {arg parsi
1d10: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
1d20: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
1d30: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
1d40: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
1d50: 6d 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 myaddr} msg] $ms
1d60: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
1d70: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
1d80: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
1d90: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
1da0: 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 "}}..test socket
1db0: 2d 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e -1.4 {arg parsin
1dc0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
1dd0: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
1de0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
1df0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
1e00: 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d yaddr 127.0.0.1}
1e10: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
1e20: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
1e30: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
1e40: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
1e50: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
1e60: 73 74 20 73 6f 63 6b 65 74 2d 31 2e 35 20 7b 61 st socket-1.5 {a
1e70: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
1e80: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
1e90: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
1ea0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
1eb0: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 socket -myport}
1ec0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
1ed0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
1ee0: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
1ef0: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
1f00: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
1f10: 74 20 73 6f 63 6b 65 74 2d 31 2e 36 20 7b 61 72 t socket-1.6 {ar
1f20: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1f30: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1f40: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1f50: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1f60: 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 ocket -myport xx
1f70: 78 78 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 xx} msg] $msg.}
1f80: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
1f90: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
1fa0: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
1fb0: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
1fc0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 37 .test socket-1.7
1fd0: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
1fe0: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
1ff0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
2000: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
2010: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 s::socket -mypor
2020: 74 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 t 2522} msg] $ms
2030: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
2040: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
2050: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 "tls::socket ?op
2060: 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 tions? host port
2070: 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 "}}..test socket
2080: 2d 31 2e 38 20 7b 61 72 67 20 70 61 72 73 69 6e -1.8 {arg parsin
2090: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
20a0: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
20b0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
20c0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 {tls::socket -f
20d0: 72 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 roboz} msg] $msg
20e0: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
20f0: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
2100: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
2110: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
2120: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
2130: 31 2e 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.9 {arg parsing
2140: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2150: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2160: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2170: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
2180: 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 rver foo -myport
2190: 20 32 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 2521 3333} msg]
21a0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
21b0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
21c0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
21d0: 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 -server command
21e0: 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 ?options? port"
21f0: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
2200: 31 2e 31 30 20 7b 61 72 67 20 70 61 72 73 69 6e 1.10 {arg parsin
2210: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
2220: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
2230: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
2240: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 68 6f {tls::socket ho
2250: 73 74 20 32 35 32 38 20 2d 6a 75 6e 6b 7d 20 6d st 2528 -junk} m
2260: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2270: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2280: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2290: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
22a0: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
22b0: 20 73 6f 63 6b 65 74 2d 31 2e 31 31 20 7b 61 72 socket-1.11 {ar
22c0: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
22d0: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
22e0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
22f0: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
2300: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 61 ocket -server ca
2310: 6c 6c 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d 20 llback 2520 --}
2320: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
2330: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
2340: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
2350: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d cket -server com
2360: 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 mand ?options? p
2370: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 ort"}}..test soc
2380: 6b 65 74 2d 31 2e 31 32 20 7b 61 72 67 20 70 61 ket-1.12 {arg pa
2390: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
23a0: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
23b0: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
23c0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
23d0: 74 20 66 6f 6f 20 62 61 64 70 6f 72 74 7d 20 6d t foo badport} m
23e0: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 65 sg] $msg.} {1 {e
23f0: 78 70 65 63 74 65 64 20 69 6e 74 65 67 65 72 20 xpected integer
2400: 62 75 74 20 67 6f 74 20 22 62 61 64 70 6f 72 74 but got "badport
2410: 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 "}}..test socket
2420: 2d 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.1 {tcp connec
2430: 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 tion} {socket st
2440: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
2450: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
2460: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
2470: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
2480: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
2490: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
24a0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
24b0: 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 2000 "set x time
24c0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 20 d_out"]. }.
24d0: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
24e0: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
24f0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
2500: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
2510: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
2520: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
2530: 72 76 65 72 4b 65 79 20 32 38 32 38 20 5c 5d 22 rverKey 2828 \]"
2540: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
2550: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
2560: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 e addr port} {..
2570: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 global x..
2580: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
2590: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
25a0: 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 file..}..puts re
25b0: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
25c0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
25d0: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
25e0: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
25f0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
2600: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
2610: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
2620: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
2630: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
2640: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
2650: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
2660: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
2670: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2680: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
2690: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
26a0: 20 32 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 2828} msg]} {.
26b0: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 set x $ms
26c0: 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 g. } else {.
26d0: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
26e0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
26f0: 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 close $msg.
2700: 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 }. lappend
2710: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
2720: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2730: 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 x.} {ready done
2740: 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 {}}..if [info e
2750: 78 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 xists port] {.
2760: 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c incr port.} el
2770: 73 65 20 7b 20 0a 20 20 20 20 73 65 74 20 70 6f se { . set po
2780: 72 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b 20 rt [expr 2048 +
2790: 5b 70 69 64 5d 25 31 30 32 34 5d 0a 7d 0a 0a 74 [pid]%1024].}..t
27a0: 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 32 20 7b est socket-2.2 {
27b0: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 tcp connection w
27c0: 69 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 74 20 ith client port
27d0: 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b specified} {sock
27e0: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
27f0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
2800: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
2810: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
2820: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
2830: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
2840: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
2850: 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 2000 "set x don
2860: 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 e"]. }. pu
2870: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
2880: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2890: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
28a0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
28b0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
28c0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
28d0: 4b 65 79 20 32 38 32 39 20 5c 5d 22 0a 20 20 20 Key 2829 \]".
28e0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
28f0: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 accept {file ad
2900: 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 dr port} {.
2910: 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a global x.
2920: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
2930: 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 20 24 "[gets $file] $
2940: 70 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 port".
2950: 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 close $file.
2960: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
2970: 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 done..}..puts re
2980: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
2990: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
29a0: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 r..close $f.
29b0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
29c0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
29d0: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
29e0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
29f0: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
2a00: 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 $f x. global
2a10: 70 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 port. if {[ca
2a20: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2a30: 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 5c -myport $port \
2a40: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
2a50: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
2a60: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
2a70: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
2a80: 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 7d 20 73 27.0.0.1 2829} s
2a90: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
2aa0: 73 65 74 20 78 20 24 73 6f 63 6b 0a 09 63 61 74 set x $sock..cat
2ab0: 63 68 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a ch {close [tls::
2ac0: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
2ad0: 20 32 38 32 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 2829]}. } el
2ae0: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 se {. put
2af0: 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 s $sock hello..f
2b00: 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 lush $sock.
2b10: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
2b20: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
2b30: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
2b40: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
2b50: 20 20 73 65 74 20 78 0a 7d 20 5b 6c 69 73 74 20 set x.} [list
2b60: 72 65 61 64 79 20 22 68 65 6c 6c 6f 20 24 70 6f ready "hello $po
2b70: 72 74 22 5d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 rt"]..test socke
2b80: 74 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e 6e 65 t-2.3 {tcp conne
2b90: 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e ction with clien
2ba0: 74 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 t interface spec
2bb0: 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 ified} {socket s
2bc0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
2bd0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
2be0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
2bf0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
2c00: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
2c10: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
2c20: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
2c30: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
2c40: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
2c50: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
2c60: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
2c70: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
2c80: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
2c90: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
2ca0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
2cb0: 32 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 2830 \]". put
2cc0: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
2cd0: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
2ce0: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
2cf0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
2d00: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
2d10: 65 74 73 20 24 66 69 6c 65 5d 20 24 61 64 64 72 ets $file] $addr
2d20: 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c ". cl
2d30: 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 ose $file.
2d40: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
2d50: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
2d60: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
2d70: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
2d80: 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 lose $f. }.
2d90: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
2da0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
2db0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
2dc0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
2dd0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
2de0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
2df0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
2e00: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 5c addr 127.0.0.1 \
2e10: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 ..-certfile $cli
2e20: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
2e30: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
2e40: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
2e50: 32 37 2e 30 2e 30 2e 31 20 32 38 33 30 7d 20 73 27.0.0.1 2830} s
2e60: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
2e70: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
2e80: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
2e90: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
2ea0: 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 20 o..catch {flush
2eb0: 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 6c $sock}. l
2ec0: 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 append x [gets $
2ed0: 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 f]. close
2ee0: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 $sock. }.
2ef0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2f00: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 t x.} {ready {he
2f10: 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a llo 127.0.0.1}}.
2f20: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 34 .test socket-2.4
2f30: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
2f40: 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 with server int
2f50: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
2f60: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
2f70: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
2f80: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
2f90: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
2fa0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
2fb0: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
2fc0: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
2fd0: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
2fe0: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
2ff0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3000: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3010: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3020: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
3030: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
3040: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
3050: 24 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 $serverKey -myad
3060: 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d dr [info hostnam
3070: 65 5d 20 32 38 33 31 20 5c 5d 22 0a 20 20 20 20 e] 2831 \]".
3080: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
3090: 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 accept {file add
30a0: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 r port} {.
30b0: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
30c0: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
30d0: 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 "[gets $file]".
30e0: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
30f0: 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 $file.
3100: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
3110: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
3120: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
3130: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
3140: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
3150: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
3160: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
3170: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
3180: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
3190: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
31a0: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
31b0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
31c0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
31d0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
31e0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
31f0: 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 entKey [info hos
3200: 74 6e 61 6d 65 5d 20 32 38 33 31 7d 20 73 6f 63 tname] 2831} soc
3210: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 k]} {. se
3220: 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 t x $sock. }
3230: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 else {. p
3240: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a uts $sock hello.
3250: 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 .flush $sock.
3260: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b lappend x [
3270: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 gets $f].
3280: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3290: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
32a0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
32b0: 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 dy hello}..test
32c0: 73 6f 63 6b 65 74 2d 32 2e 35 20 7b 74 63 70 20 socket-2.5 {tcp
32d0: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
32e0: 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 redundant server
32f0: 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 port} {socket s
3300: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
3310: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
3320: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
3330: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
3340: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
3350: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
3360: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
3370: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
3380: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
3390: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
33a0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
33b0: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
33c0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
33d0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
33e0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
33f0: 32 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 75 74 2832 \]". put
3400: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
3410: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
3420: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
3430: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
3440: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
3450: 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 20 20 ets $file]".
3460: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
3470: 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ile.
3480: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
3490: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
34a0: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
34b0: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
34c0: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
34d0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
34e0: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
34f0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3500: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3510: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
3520: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
3530: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
3540: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
3550: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
3560: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3570: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 Key 127.0.0.1 28
3580: 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 32} sock]} {.
3590: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
35a0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
35b0: 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b puts $sock
35c0: 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 hello..flush $s
35d0: 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 ock. lapp
35e0: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
35f0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3600: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ock. }. cl
3610: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
3620: 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d .} {ready hello}
3630: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 36 .test socket-2.6
3640: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
3650: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
3660: 20 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 set status ok.
3670: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
3680: 73 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 set sock [tls::s
3690: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
36a0: 32 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 2833]}]} {..if {
36b0: 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 ![catch {gets $s
36c0: 6f 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 ock}]} {.. se
36d0: 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a t status broken.
36e0: 09 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a .}..close $sock.
36f0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 }. set st
3700: 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 atus.} ok..test
3710: 73 6f 63 6b 65 74 2d 32 2e 37 20 7b 65 63 68 6f socket-2.7 {echo
3720: 20 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e server, one lin
3730: 65 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f e} {socket stdio
3740: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
3750: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
3760: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3770: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3780: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
3790: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
37a0: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
37b0: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
37c0: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
37d0: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
37e0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
37f0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
3800: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
3810: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
3820: 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 34 $serverKey 2834
3830: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
3840: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
3850: 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 {s a p} {.
3860: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
3870: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
3880: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
3890: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
38a0: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 ranslation lf -b
38b0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
38c0: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
38d0: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 ho {s} {.. s
38e0: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 et l [gets $s].
38f0: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b if {
3900: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 [eof $s]} {.
3910: 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f glo
3920: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
3930: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a close $s.
3940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3950: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
3960: 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 } else
3970: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
3980: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
3990: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a }..}.
39a0: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
39b0: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
39c0: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
39d0: 20 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 $f..puts done.
39e0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
39f0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
3a00: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
3a10: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
3a20: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
3a30: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 ts $f. set s
3a40: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
3a50: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
3a60: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3a70: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
3a80: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
3a90: 30 2e 31 20 32 38 33 34 5d 0a 20 20 20 20 66 63 0.1 2834]. fc
3aa0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
3ab0: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
3ac0: 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 nslation lf.
3ad0: 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 puts $s "hello a
3ae0: 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 bcdefghijklmnop"
3af0: 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 0a . after 1000.
3b00: 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 set x [gets
3b10: 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s]. close $s
3b20: 0a 20 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 . set y [gets
3b30: 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $f]. close $
3b40: 66 0a 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 f. list $x $y
3b50: 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 .} {{hello abcde
3b60: 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e fghijklmnop} don
3b70: 65 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d e}..test socket-
3b80: 32 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2.8 {echo server
3b90: 2c 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c , loop 50 times,
3ba0: 20 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 single connecti
3bb0: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 on} {socket stdi
3bc0: 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 20 5b o} {. set f [
3bd0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
3be0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
3bf0: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
3c00: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
3c10: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
3c20: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
3c30: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
3c40: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
3c50: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3c60: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
3c70: 65 72 4b 65 79 20 32 38 33 35 20 5c 5d 22 0a 20 erKey 2835 \]".
3c80: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
3c90: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
3ca0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
3cb0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
3cc0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
3cd0: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
3ce0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
3cf0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
3d00: 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 }..proc e
3d10: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 cho {s} {..
3d20: 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 global i.
3d30: 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 set l [get
3d40: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 s $s].
3d50: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
3d60: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
3d70: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
3d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c cl
3d90: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
3da0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
3db0: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ne.
3dc0: 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 } else { ..
3dd0: 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 incr i.
3de0: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
3df0: 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 $s $l.
3e00: 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 }..}..set i
3e10: 30 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 0..puts ready..s
3e20: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
3e30: 32 30 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 20000 "set x don
3e40: 65 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 e"]..vwait x..af
3e50: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
3e60: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
3e70: 73 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 s "done $i".
3e80: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
3e90: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
3ea0: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
3eb0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
3ec0: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
3ed0: 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c $f. set s [tl
3ee0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
3ef0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
3f00: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
3f10: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
3f20: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
3f30: 20 32 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 2835]. fconf
3f40: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
3f50: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 ing line. cat
3f60: 63 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 ch {..for {set x
3f70: 20 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 0} {$x < 50} {i
3f80: 6e 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 ncr x} {.. pu
3f90: 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 ts $s "hello abc
3fa0: 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 defghijklmnop"..
3fb0: 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 gets $s..}.
3fc0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3fd0: 73 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 s. catch {set
3fe0: 20 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 x [gets $f]}.
3ff0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
4000: 65 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d et x.} {done 50}
4010: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e ..test socket-2.
4020: 39 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 9 {socket confli
4030: 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ct} {socket stdi
4040: 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b o} {. set s [
4050: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4060: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d ver accept 2828]
4070: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
4080: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
4090: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
40a0: 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
40b0: 6c 69 6e 65 20 24 66 20 7b 70 61 63 6b 61 67 65 line $f {package
40c0: 20 72 65 71 75 69 72 65 20 74 6c 73 3b 20 74 6c require tls; tl
40d0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
40e0: 72 20 61 63 63 65 70 74 20 32 38 32 38 7d 0a 20 r accept 2828}.
40f0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4100: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
4110: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
4120: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
4130: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
4140: 20 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 after 100.
4150: 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 set x [list [c
4160: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 atch {close $f}
4170: 6d 73 67 5d 20 24 6d 73 67 5d 0a 20 20 20 20 63 msg] $msg]. c
4180: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
4190: 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 x.} {1 {couldn't
41a0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
41b0: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
41c0: 20 75 73 65 0a 20 20 20 20 77 68 69 6c 65 20 65 use. while e
41d0: 78 65 63 75 74 69 6e 67 0a 22 3a 3a 73 6f 63 6b xecuting."::sock
41e0: 65 74 20 2d 73 65 72 76 65 72 20 7b 74 6c 73 3a et -server {tls:
41f0: 3a 5f 61 63 63 65 70 74 20 7b 2d 73 65 72 76 65 :_accept {-serve
4200: 72 20 31 7d 20 61 63 63 65 70 74 7d 20 32 38 32 r 1} accept} 282
4210: 38 22 0a 20 20 20 20 28 22 65 76 61 6c 22 20 62 8". ("eval" b
4220: 6f 64 79 20 6c 69 6e 65 20 31 29 0a 20 20 20 20 ody line 1).
4230: 69 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 invoked from wit
4240: 68 69 6e 0a 22 65 76 61 6c 20 3a 3a 73 6f 63 6b hin."eval ::sock
4250: 65 74 20 24 73 6f 70 74 73 22 0a 20 20 20 20 28 et $sopts". (
4260: 70 72 6f 63 65 64 75 72 65 20 22 74 6c 73 3a 3a procedure "tls::
4270: 73 6f 63 6b 65 74 22 20 6c 69 6e 65 20 36 32 29 socket" line 62)
4280: 0a 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f . invoked fro
4290: 6d 20 77 69 74 68 69 6e 0a 22 74 6c 73 3a 3a 73 m within."tls::s
42a0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
42b0: 63 65 70 74 20 32 38 32 38 22 0a 20 20 20 20 28 cept 2828". (
42c0: 66 69 6c 65 20 22 73 63 72 69 70 74 22 20 6c 69 file "script" li
42d0: 6e 65 20 31 29 7d 7d 0a 0a 74 65 73 74 20 73 6f ne 1)}}..test so
42e0: 63 6b 65 74 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 cket-2.10 {close
42f0: 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 on accept, acce
4300: 70 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 pted socket live
4310: 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 s} {socket pcCra
4320: 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 6f sh} {. set do
4330: 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d ne 0. set tim
4340: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 er [after 20000
4350: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
4360: 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 73 out"]. set ss
4370: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
4380: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
4390: 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 0]. proc acce
43a0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
43b0: 6f 62 61 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24 obal ss..close $
43c0: 73 73 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 ss..fileevent $s
43d0: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 readable "readi
43e0: 74 20 24 73 22 0a 09 66 63 6f 6e 66 69 67 75 72 t $s"..fconfigur
43f0: 65 20 24 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20 e $s -trans lf.
4400: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
4410: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
4420: 61 6c 20 64 6f 6e 65 0a 09 67 65 74 73 20 24 73 al done..gets $s
4430: 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 ..close $s..set
4440: 64 6f 6e 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 done 1. }.
4450: 20 73 65 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f set cs [tls::so
4460: 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e cket [info hostn
4470: 61 6d 65 5d 20 32 38 33 30 5d 0a 20 20 20 20 70 ame] 2830]. p
4480: 75 74 73 20 24 63 73 20 68 65 6c 6c 6f 0a 20 20 uts $cs hello.
4490: 20 20 63 6c 6f 73 65 20 24 63 73 0a 20 20 20 20 close $cs.
44a0: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
44b0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
44c0: 65 72 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a er. set done.
44d0: 7d 20 31 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d } 1.test socket-
44e0: 32 2e 31 31 20 7b 64 65 74 65 63 74 69 6e 67 20 2.11 {detecting
44f0: 6e 65 77 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 new data} {socke
4500: 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 t pcCrash} {.
4510: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
4520: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 a p} {..global s
4530: 6f 63 6b 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 ock..set sock $s
4540: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 . }.. set
4550: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d s [tls::socket -
4560: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 34 server accept 24
4570: 30 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 00]. set sock
4580: 20 22 22 0a 20 20 20 20 73 65 74 20 73 32 20 5b "". set s2 [
4590: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
45a0: 30 2e 30 2e 31 20 32 34 30 30 5d 0a 20 20 20 20 0.0.1 2400].
45b0: 76 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 20 70 vwait sock. p
45c0: 75 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 20 20 uts $s2 one.
45d0: 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 61 66 flush $s2. af
45e0: 74 65 72 20 35 30 30 0a 20 20 20 20 66 63 6f 6e ter 500. fcon
45f0: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c figure $sock -bl
4600: 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 65 74 ocking 0. set
4610: 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 result [gets $s
4620: 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 ock]. lappend
4630: 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 73 result [gets $s
4640: 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 ock]. fconfig
4650: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
4660: 69 6e 67 20 31 0a 20 20 20 20 70 75 74 73 20 24 ing 1. puts $
4670: 73 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 s2 two. flush
4680: 20 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 $s2. fconfig
4690: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
46a0: 69 6e 67 20 30 0a 20 20 20 20 6c 61 70 70 65 6e ing 0. lappen
46b0: 64 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 24 d result [gets $
46c0: 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 sock]. fconfi
46d0: 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 gure $sock -bloc
46e0: 6b 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 king 1. close
46f0: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
4700: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 s. close $soc
4710: 6b 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 k. set result
4720: 0a 7d 20 7b 6f 6e 65 20 7b 7d 20 74 77 6f 7d 0a .} {one {} two}.
4730: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 31 .test socket-2.1
4740: 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 2 {tcp connectio
4750: 6e 3b 20 6e 6f 20 63 65 72 74 69 66 69 63 61 74 n; no certificat
4760: 65 73 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 es specified} {s
4770: 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 ocket stdio pcCr
4780: 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ash} {. remov
4790: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
47a0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
47b0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
47c0: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
47d0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
47e0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
47f0: 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 2000 "set x time
4800: 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 5b d_out"]..set f [
4810: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4820: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d ver accept 2828]
4830: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 ..proc accept {f
4840: 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b ile addr port} {
4850: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
4860: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
4870: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
4880: 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 $file..}..puts
4890: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
48a0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
48b0: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 mer..close $f..p
48c0: 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 uts $x. }.
48d0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
48e0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
48f0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
4900: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
4910: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
4920: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
4930: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
4940: 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 5d 0.0.1 2828} msg]
4950: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
4960: 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 x $msg. } els
4970: 65 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 e {. lapp
4980: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
4990: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d close $m
49a0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 sg. }. lap
49b0: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
49c0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
49d0: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
49e0: 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 0a 0a 0a 74 65 done {}}.....te
49f0: 73 74 20 73 6f 63 6b 65 74 2d 33 2e 31 20 7b 73 st socket-3.1 {s
4a00: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
4a10: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
4a20: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
4a30: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
4a40: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
4a50: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 . puts $f {.
4a60: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
4a70: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b ire tls..set f [
4a80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4a90: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d ver accept 2828]
4aa0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 67 65 ..puts ready..ge
4ab0: 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 ts stdin..close
4ac0: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
4ad0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
4ae0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
4af0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
4b00: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
4b10: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
4b20: 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 et x [list [catc
4b30: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
4b40: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
4b50: 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 28} msg] \...$ms
4b60: 67 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 62 g]. puts $f b
4b70: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a ye. close $f.
4b80: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b set x.} {1 {
4b90: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
4ba0: 63 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c cket: address al
4bb0: 72 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a ready in use}}..
4bc0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 33 2e 32 20 test socket-3.2
4bd0: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
4be0: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
4bf0: 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 ocket stdio pcCr
4c00: 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ash} {. remov
4c10: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
4c20: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
4c30: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
4c40: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
4c50: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
4c60: 65 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 et t1 [after 300
4c70: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
4c80: 6f 75 74 22 5d 0a 09 73 65 74 20 74 32 20 5b 61 out"]..set t2 [a
4c90: 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 20 fter 31000 "set
4ca0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
4cb0: 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 et t3 [after 320
4cc0: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
4cd0: 6f 75 74 22 5d 0a 09 73 65 74 20 63 6f 75 6e 74 out"]..set count
4ce0: 65 72 20 30 0a 09 73 65 74 20 73 20 5b 74 6c 73 er 0..set s [tls
4cf0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4d00: 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 70 accept 2828]..p
4d10: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
4d20: 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 p} {.. fileev
4d30: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
4d40: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
4d50: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
4d60: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
4d70: 65 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 e..}..proc echo
4d80: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
4d90: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
4da0: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
4db0: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
4dc0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
4dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4de0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
4df0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
4e00: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
4e10: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
4e20: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
4e30: 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 $s $l.
4e40: 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 }..}..puts r
4e50: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
4e60: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 0a fter cancel $t1.
4e70: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
4e80: 63 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 61 69 cancel $t2..vwai
4e90: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
4ea0: 6c 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 73 0a l $t3..close $s.
4eb0: 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 .puts $x. }.
4ec0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4ed0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
4ee0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
4ef0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
4f00: 20 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 5b r+]. set x [
4f10: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 73 65 74 gets $f]. set
4f20: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
4f30: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 127.0.0.1 2828]
4f40: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4f50: 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s1 -buffering l
4f60: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 5b ine. set s2 [
4f70: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
4f80: 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 0.0.1 2828].
4f90: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d fconfigure $s2 -
4fa0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
4fb0: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
4fc0: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
4fd0: 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 2828]. fconf
4fe0: 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 igure $s3 -buffe
4ff0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f ring line. fo
5000: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
5010: 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 < 100} {incr i}
5020: 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c {..puts $s1 hell
5030: 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 o,s1..gets $s1..
5040: 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 puts $s2 hello,s
5050: 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 2..gets $s2..put
5060: 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 s $s3 hello,s3..
5070: 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 gets $s3. }.
5080: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
5090: 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 close $s2. c
50a0: 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 6c 61 70 lose $s3. lap
50b0: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
50c0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
50d0: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
50e0: 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 73 6f 63 done}..test soc
50f0: 6b 65 74 2d 34 2e 31 20 7b 73 65 72 76 65 72 20 ket-4.1 {server
5100: 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 with several cli
5110: 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 ents} {socket st
5120: 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 dio pcCrash} {.
5130: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
5140: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
5150: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
5160: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
5170: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
5180: 65 20 74 6c 73 0a 09 67 65 74 73 20 73 74 64 69 e tls..gets stdi
5190: 6e 0a 09 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 n..set s [tls::s
51a0: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
51b0: 32 38 32 38 5d 0a 09 66 63 6f 6e 66 69 67 75 72 2828]..fconfigur
51c0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
51d0: 6c 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 20 69 line..for {set i
51e0: 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 0} {$i < 100} {
51f0: 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 20 70 incr i} {.. p
5200: 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 20 20 uts $s hello..
5210: 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 63 6c gets $s..}..cl
5220: 6f 73 65 20 24 73 0a 09 70 75 74 73 20 62 79 65 ose $s..puts bye
5230: 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 ..gets stdin.
5240: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
5250: 20 20 20 20 73 65 74 20 70 31 20 5b 6f 70 65 6e set p1 [open
5260: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
5270: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
5280: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 ipt]" r+]. fc
5290: 6f 6e 66 69 67 75 72 65 20 24 70 31 20 2d 62 75 onfigure $p1 -bu
52a0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
52b0: 20 73 65 74 20 70 32 20 5b 6f 70 65 6e 20 22 7c set p2 [open "|
52c0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
52d0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
52e0: 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 ]" r+]. fconf
52f0: 69 67 75 72 65 20 24 70 32 20 2d 62 75 66 66 65 igure $p2 -buffe
5300: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
5310: 74 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 t p3 [open "|[li
5320: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
5330: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
5340: 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 r+]. fconfigu
5350: 72 65 20 24 70 33 20 2d 62 75 66 66 65 72 69 6e re $p3 -bufferin
5360: 67 20 6c 69 6e 65 0a 20 20 20 20 70 72 6f 63 20 g line. proc
5370: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
5380: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
5390: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
53a0: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
53b0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
53c0: 6f 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 o $s]. }.
53d0: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
53e0: 09 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 .global x.
53f0: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
5400: 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 ]. if {[e
5410: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
5420: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
5430: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
5440: 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 7d 20 done. }
5450: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 else {.
5460: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
5470: 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 }. }.
5480: 20 20 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 set t1 [after
5490: 33 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 30000 "set x tim
54a0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 ed_out"]. set
54b0: 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 30 t2 [after 31000
54c0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
54d0: 74 22 5d 0a 20 20 20 20 73 65 74 20 74 33 20 5b t"]. set t3 [
54e0: 61 66 74 65 72 20 33 32 30 30 30 20 22 73 65 74 after 32000 "set
54f0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
5500: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
5510: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
5520: 63 65 70 74 20 32 38 32 38 5d 0a 20 20 20 20 70 cept 2828]. p
5530: 75 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 uts $p1 open.
5540: 20 70 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 puts $p2 open.
5550: 20 20 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e puts $p3 open
5560: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
5570: 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 vwait x. vwa
5580: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
5590: 61 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 ancel $t1. af
55a0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 ter cancel $t2.
55b0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
55c0: 24 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $t3. close $s
55d0: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
55e0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
55f0: 74 20 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 t p1 [gets $p1]
5600: 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $x]. lappend
5610: 6c 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 l [list p2 [gets
5620: 20 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 $p2] $x]. la
5630: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 ppend l [list p3
5640: 20 5b 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a [gets $p3] $x].
5650: 20 20 20 20 70 75 74 73 20 24 70 31 20 62 79 65 puts $p1 bye
5660: 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 62 79 . puts $p2 by
5670: 65 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 62 e. puts $p3 b
5680: 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 ye. close $p1
5690: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 . close $p2.
56a0: 20 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 close $p3.
56b0: 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 set l.} {{p1 by
56c0: 65 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 e done} {p2 bye
56d0: 64 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f done} {p3 bye do
56e0: 6e 65 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 ne}}..test socke
56f0: 74 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 t-4.2 {byte orde
5700: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
5710: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
5720: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
5730: 20 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 set x ok. i
5740: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
5750: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 socket -server d
5760: 6f 64 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 5d odo 0x3000} msg]
5770: 7d 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 0a } {..set x $msg.
5780: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c } else {..cl
5790: 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ose $msg. }.
57a0: 20 20 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 set x.} ok..t
57b0: 65 73 74 20 73 6f 63 6b 65 74 2d 35 2e 31 20 7b est socket-5.1 {
57c0: 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c byte order probl
57d0: 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 ems, socket numb
57e0: 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b ers, htons} \..{
57f0: 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 socket unixOnly
5800: 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 notRoot} {. s
5810: 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f et x {couldn't o
5820: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
5830: 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 owner}. if {!
5840: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
5850: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
5860: 20 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 0x1} msg]} {.
5870: 20 20 20 20 20 20 73 65 74 20 78 20 7b 68 74 6f set x {hto
5880: 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 ns problem, shou
5890: 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 ld be disallowed
58a0: 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e , are you runnin
58b0: 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 g as SU?}..close
58c0: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
58d0: 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 set x.} {couldn'
58e0: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e t open socket: n
58f0: 6f 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74 20 73 ot owner}.test s
5900: 6f 63 6b 65 74 2d 35 2e 32 20 7b 62 79 74 65 20 ocket-5.2 {byte
5910: 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 order problems,
5920: 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 socket numbers,
5930: 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 htons} {socket}
5940: 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 {. set x {cou
5950: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
5960: 74 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 t: port number t
5970: 6f 6f 20 68 69 67 68 7d 0a 20 20 20 20 69 66 20 oo high}. if
5980: 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {![catch {tls::s
5990: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f ocket -server do
59a0: 64 6f 20 30 78 31 30 30 30 30 7d 20 6d 73 67 5d do 0x10000} msg]
59b0: 7d 20 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 74 } {..set x {port
59c0: 20 72 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 resolution prob
59d0: 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 lem, should be d
59e0: 69 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 isallowed}..clos
59f0: 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 e $msg. }.
5a00: 20 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e set x.} {couldn
5a10: 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 't open socket:
5a20: 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 port number too
5a30: 68 69 67 68 7d 0a 74 65 73 74 20 73 6f 63 6b 65 high}.test socke
5a40: 74 2d 35 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 t-5.3 {byte orde
5a50: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
5a60: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
5a70: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e s} \..{socket un
5a80: 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 ixOnly notRoot}
5a90: 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 {. set x {cou
5aa0: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
5ab0: 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 t: not owner}.
5ac0: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 if {![catch {t
5ad0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
5ae0: 65 72 20 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d er dodo 21} msg]
5af0: 7d 20 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e } {..set x {hton
5b00: 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c s problem, shoul
5b10: 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c d be disallowed,
5b20: 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 are you running
5b30: 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 as SU?}..close
5b40: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
5b50: 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 et x.} {couldn't
5b60: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f open socket: no
5b70: 74 20 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 20 73 t owner}..test s
5b80: 6f 63 6b 65 74 2d 36 2e 31 20 7b 61 63 63 65 70 ocket-6.1 {accep
5b90: 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 t callback error
5ba0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 } {socket stdio
5bb0: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 pcCrash} {. r
5bc0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
5bd0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5be0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
5bf0: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
5c00: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
5c10: 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 74 s..gets stdin..t
5c20: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
5c30: 2e 30 2e 31 20 32 38 34 38 0a 20 20 20 20 7d 0a .0.1 2848. }.
5c40: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
5c50: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
5c60: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5c70: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5c80: 22 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 " r+]. proc b
5c90: 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 gerror args {..g
5ca0: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 lobal x..set x $
5cb0: 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 args. }. p
5cc0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
5cd0: 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d p} {expr 10 / 0}
5ce0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
5cf0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
5d00: 61 63 63 65 70 74 20 32 38 34 38 5d 0a 20 20 20 accept 2848].
5d10: 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 puts $f hello.
5d20: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5d30: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
5d40: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
5d50: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
5d60: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
5d70: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
5d80: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 close $s. r
5d90: 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d ename bgerror {}
5da0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 . set x.} {{d
5db0: 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a ivide by zero}}.
5dc0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 31 .test socket-7.1
5dd0: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
5de0: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
5df0: 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f s} {socket stdio
5e00: 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 pcCrash} {.
5e10: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
5e20: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
5e30: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
5e40: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
5e50: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
5e60: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
5e70: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 30 0a ver accept 2820.
5e80: 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 .proc accept arg
5e90: 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 s {.. global
5ea0: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
5eb0: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
5ec0: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
5ed0: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
5ee0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 timed_out"]..vwa
5ef0: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
5f00: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a el $timer. }.
5f10: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
5f20: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
5f30: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5f40: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5f50: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
5f60: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
5f70: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
5f80: 31 20 32 38 32 30 5d 0a 20 20 20 20 73 65 74 20 1 2820]. set
5f90: 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 p [fconfigure $s
5fa0: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 -peername].
5fb0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
5fc0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 se $f. set l
5fd0: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
5fe0: 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 [string compare
5ff0: 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 20 31 [lindex $p 0] 1
6000: 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 27.0.0.1]. la
6010: 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 ppend l [string
6020: 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 compare [lindex
6030: 24 70 20 32 5d 20 32 38 32 30 5d 0a 20 20 20 20 $p 2] 2820].
6040: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 lappend l [lleng
6050: 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20 33 7d th $p].} {0 0 3}
6060: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 32 .test socket-7.2
6070: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
6080: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
6090: 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f s} {socket stdio
60a0: 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 pcCrash} {.
60b0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
60c0: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
60d0: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
60e0: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
60f0: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
6100: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6110: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 31 0a ver accept 2821.
6120: 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 .proc accept arg
6130: 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 s {.. global
6140: 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e x.. set x don
6150: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
6160: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
6170: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 er 10000 "set x
6180: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 timed_out"]..vwa
6190: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
61a0: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a el $timer. }.
61b0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
61c0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
61d0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
61e0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
61f0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
6200: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6210: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
6220: 31 20 32 38 32 31 5d 0a 20 20 20 20 73 65 74 20 1 2821]. set
6230: 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 p [fconfigure $s
6240: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 -sockname].
6250: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
6260: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 se $f. set l
6270: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
6280: 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 [llength $p].
6290: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
62a0: 64 65 78 20 24 70 20 30 5d 0a 20 20 20 20 6c 61 dex $p 0]. la
62b0: 70 70 65 6e 64 20 6c 20 5b 65 78 70 72 20 5b 6c ppend l [expr [l
62c0: 69 6e 64 65 78 20 24 70 20 32 5d 20 3d 3d 20 32 index $p 2] == 2
62d0: 38 32 31 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 821].} {3 127.0.
62e0: 30 2e 31 20 30 7d 0a 74 65 73 74 20 73 6f 63 6b 0.1 0}.test sock
62f0: 65 74 2d 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 et-7.3 {testing
6300: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
6310: 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 options} {socket
6320: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
6330: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
6340: 65 72 20 61 63 63 65 70 74 20 32 38 32 32 5d 0a er accept 2822].
6350: 20 20 20 20 73 65 74 20 6c 20 5b 66 63 6f 6e 66 set l [fconf
6360: 69 67 75 72 65 20 24 73 5d 0a 20 20 20 20 63 6c igure $s]. cl
6370: 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 ose $s. updat
6380: 65 0a 20 20 20 20 6c 6c 65 6e 67 74 68 20 24 6c e. llength $l
6390: 0a 7d 20 31 32 0a 74 65 73 74 20 73 6f 63 6b 65 .} 12.test socke
63a0: 74 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 20 73 t-7.4 {testing s
63b0: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
63c0: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
63d0: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 pcCrash} {. s
63e0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
63f0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
6400: 20 32 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 20 2823]. proc
6410: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
6420: 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 ..global x..set
6430: 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 x [fconfigure $s
6440: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f -sockname]..clo
6450: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
6460: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
6470: 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 ket [info hostna
6480: 6d 65 5d 20 32 38 32 33 5d 0a 20 20 20 20 73 65 me] 2823]. se
6490: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
64a0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
64b0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
64c0: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
64d0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
64e0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
64f0: 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c se $s1. set l
6500: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
6510: 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 l [lindex $x 2]
6520: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
6530: 32 38 32 33 20 33 7d 0a 0a 74 65 73 74 20 73 6f 2823 3}..test so
6540: 63 6b 65 74 2d 37 2e 35 20 7b 74 65 73 74 69 6e cket-7.5 {testin
6550: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
6560: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b c options} {sock
6570: 65 74 20 75 6e 69 78 4f 72 50 63 20 70 63 43 72 et unixOrPc pcCr
6580: 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ash} {. set s
6590: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
65a0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
65b0: 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 9]. proc acce
65c0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
65d0: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
65e0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
65f0: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
6600: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
6610: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
6620: 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 5d 0a 127.0.0.1 2829].
6630: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
6640: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
6650: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
6660: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 vwait x. af
6670: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
6680: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
6690: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
66a0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
66b0: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
66c0: 24 78 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 78 $x 0] [lindex $x
66d0: 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 2] [llength $x]
66e0: 0a 7d 20 7b 31 32 37 2e 30 2e 30 2e 31 20 32 38 .} {127.0.0.1 28
66f0: 32 39 20 33 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 29 3}..test sock
6700: 65 74 2d 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 et-8.1 {testing
6710: 2d 61 73 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 -async flag on s
6720: 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 20 ockets} {socket
6730: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 23 pcCrash} {. #
6740: 20 4e 4f 54 45 3a 20 54 68 69 73 20 74 65 73 74 NOTE: This test
6750: 20 6d 61 79 20 66 61 69 6c 20 6f 6e 20 73 6f 6d may fail on som
6760: 65 20 53 6f 6c 61 72 69 73 20 32 2e 34 20 73 79 e Solaris 2.4 sy
6770: 73 74 65 6d 73 2e 20 49 66 20 69 74 20 64 6f 65 stems. If it doe
6780: 73 2c 0a 20 20 20 20 23 20 63 68 65 63 6b 20 74 s,. # check t
6790: 68 61 74 20 79 6f 75 20 68 61 76 65 20 74 68 65 hat you have the
67a0: 73 65 20 70 61 74 63 68 65 73 20 69 6e 73 74 61 se patches insta
67b0: 6c 6c 65 64 20 28 75 73 69 6e 67 20 73 68 6f 77 lled (using show
67c0: 72 65 76 20 2d 70 29 3a 0a 20 20 20 20 23 0a 20 rev -p):. #.
67d0: 20 20 20 23 20 31 30 31 39 30 37 2d 30 35 2c 20 # 101907-05,
67e0: 31 30 31 39 32 35 2d 30 32 2c 20 31 30 31 39 34 101925-02, 10194
67f0: 35 2d 31 34 2c 20 31 30 31 39 35 39 2d 30 33 2c 5-14, 101959-03,
6800: 20 31 30 31 39 36 39 2d 30 35 2c 20 31 30 31 39 101969-05, 1019
6810: 37 33 2d 30 33 2c 0a 20 20 20 20 23 20 31 30 31 73-03,. # 101
6820: 39 37 37 2d 30 33 2c 20 31 30 31 39 38 31 2d 30 977-03, 101981-0
6830: 32 2c 20 31 30 31 39 38 35 2d 30 31 2c 20 31 30 2, 101985-01, 10
6840: 32 30 30 31 2d 30 33 2c 20 31 30 32 30 30 33 2d 2001-03, 102003-
6850: 30 31 2c 20 31 30 32 30 30 37 2d 30 31 2c 0a 20 01, 102007-01,.
6860: 20 20 20 23 20 31 30 32 30 31 31 2d 30 32 2c 20 # 102011-02,
6870: 31 30 32 30 32 34 2d 30 31 2c 20 31 30 32 30 33 102024-01, 10203
6880: 39 2d 30 31 2c 20 31 30 32 30 34 34 2d 30 31 2c 9-01, 102044-01,
6890: 20 31 30 32 30 34 38 2d 30 31 2c 20 31 30 32 30 102048-01, 1020
68a0: 36 32 2d 30 33 2c 0a 20 20 20 20 23 20 31 30 32 62-03,. # 102
68b0: 30 36 36 2d 30 34 2c 20 31 30 32 30 37 30 2d 30 066-04, 102070-0
68c0: 31 2c 20 31 30 32 31 30 35 2d 30 31 2c 20 31 30 1, 102105-01, 10
68d0: 32 31 35 33 2d 30 33 2c 20 31 30 32 32 31 36 2d 2153-03, 102216-
68e0: 30 31 2c 20 31 30 32 32 33 32 2d 30 31 2c 0a 20 01, 102232-01,.
68f0: 20 20 20 23 20 31 30 31 38 37 38 2d 30 33 2c 20 # 101878-03,
6900: 31 30 31 38 37 39 2d 30 31 2c 20 31 30 31 38 38 101879-01, 10188
6910: 30 2d 30 33 2c 20 31 30 31 39 33 33 2d 30 31 2c 0-03, 101933-01,
6920: 20 31 30 31 39 35 30 2d 30 31 2c 20 31 30 32 30 101950-01, 1020
6930: 33 30 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 32 30-01,. # 102
6940: 30 35 37 2d 30 38 2c 20 31 30 32 31 34 30 2d 30 057-08, 102140-0
6950: 31 2c 20 31 30 31 39 32 30 2d 30 32 2c 20 31 30 1, 101920-02, 10
6960: 31 39 32 31 2d 30 39 2c 20 31 30 31 39 32 32 2d 1921-09, 101922-
6970: 30 37 2c 20 31 30 31 39 32 33 2d 30 33 0a 20 20 07, 101923-03.
6980: 20 20 23 0a 20 20 20 20 23 20 49 66 20 61 66 74 #. # If aft
6990: 65 72 20 69 6e 73 74 61 6c 6c 69 6e 67 20 74 68 er installing th
69a0: 65 73 65 20 70 61 74 63 68 65 73 20 79 6f 75 20 ese patches you
69b0: 61 72 65 20 73 74 69 6c 6c 20 65 78 70 65 72 69 are still experi
69c0: 65 6e 63 69 6e 67 20 61 0a 20 20 20 20 23 20 70 encing a. # p
69d0: 72 6f 62 6c 65 6d 2c 20 70 6c 65 61 73 65 20 65 roblem, please e
69e0: 6d 61 69 6c 20 6a 79 6c 40 65 6e 67 2e 73 75 6e mail jyl@eng.sun
69f0: 2e 63 6f 6d 2e 20 57 65 20 68 61 76 65 20 6e 6f .com. We have no
6a00: 74 20 6f 62 73 65 72 76 65 64 20 74 68 69 73 0a t observed this.
6a10: 20 20 20 20 23 20 66 61 69 6c 75 72 65 20 6f 6e # failure on
6a20: 20 53 6f 6c 61 72 69 73 20 32 2e 35 2c 20 73 6f Solaris 2.5, so
6a30: 20 61 6e 6f 74 68 65 72 20 6f 70 74 69 6f 6e 20 another option
6a40: 28 69 6e 73 74 65 61 64 20 6f 66 20 69 6e 73 74 (instead of inst
6a50: 61 6c 6c 69 6e 67 0a 20 20 20 20 23 20 74 68 65 alling. # the
6a60: 73 65 20 70 61 74 63 68 65 73 29 20 69 73 20 74 se patches) is t
6a70: 6f 20 75 70 67 72 61 64 65 20 74 6f 20 53 6f 6c o upgrade to Sol
6a80: 61 72 69 73 20 32 2e 35 2e 0a 20 20 20 20 73 65 aris 2.5.. se
6a90: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
6aa0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
6ab0: 32 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 2830]. proc a
6ac0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
6ad0: 09 67 6c 6f 62 61 6c 20 78 0a 09 70 75 74 73 20 .global x..puts
6ae0: 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 $s bye..close $s
6af0: 0a 09 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 ..set x done.
6b00: 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 }. set s1 [t
6b10: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 61 73 79 6e ls::socket -asyn
6b20: 63 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 c [info hostname
6b30: 5d 20 32 38 33 30 5d 0a 20 20 20 20 76 77 61 69 ] 2830]. vwai
6b40: 74 20 78 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 t x. set z [g
6b50: 65 74 73 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f ets $s1]. clo
6b60: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
6b70: 24 73 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 $s1. set z.}
6b80: 62 79 65 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 bye..test socket
6b90: 2d 39 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 -9.1 {testing sp
6ba0: 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b urious events} {
6bb0: 73 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d 20 socket pcCrash}
6bc0: 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 0a {. set len 0.
6bd0: 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 73 set spurious
6be0: 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 0. set done
6bf0: 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 6c 0. proc readl
6c00: 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f ittle {s} {..glo
6c10: 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f 6e bal spurious don
6c20: 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 e len..set l [re
6c30: 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 ad $s 1]..if {[s
6c40: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
6c50: 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 == 0} {.. if
6c60: 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 {![eof $s]} {..
6c70: 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a 09 .incr spurious..
6c80: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 } else {...c
6c90: 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f lose $s...set do
6ca0: 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 ne 1.. }..} e
6cb0: 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 lse {.. incr
6cc0: 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 len [string leng
6cd0: 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a th $l]..}. }.
6ce0: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
6cf0: 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 {s a p} {..fconf
6d00: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
6d10: 69 6e 67 20 6e 6f 6e 65 20 2d 62 6c 6f 63 6b 69 ing none -blocki
6d20: 6e 67 20 6f 66 66 0a 09 66 69 6c 65 65 76 65 6e ng off..fileeven
6d30: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
6d40: 69 73 74 20 72 65 61 64 6c 69 74 74 6c 65 20 24 ist readlittle $
6d50: 73 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s]. }. set
6d60: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
6d70: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
6d80: 38 33 31 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 831]. set c [
6d90: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 tls::socket [inf
6da0: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 o hostname] 2831
6db0: 5d 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 ]. puts -none
6dc0: 77 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 wline $c 0123456
6dd0: 37 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 7890123456789012
6de0: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
6df0: 39 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 90123456789.
6e00: 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 close $c. set
6e10: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
6e20: 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 000 "set done ti
6e30: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6e40: 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 ait done. aft
6e50: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
6e60: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
6e70: 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 list $spurious
6e80: 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a $len.} {0 50}..
6e90: 74 65 73 74 20 73 6f 63 6b 65 74 2d 39 2e 32 20 test socket-9.2
6ea0: 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 {testing async w
6eb0: 72 69 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 rite, fileevents
6ec0: 2c 20 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 , flush on close
6ed0: 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 } {socket pcCras
6ee0: 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 69 72 h} {. set fir
6ef0: 73 74 62 6c 6f 63 6b 20 22 22 0a 20 20 20 20 66 stblock "". f
6f00: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
6f10: 20 3c 20 35 7d 20 7b 69 6e 63 72 20 69 7d 20 7b < 5} {incr i} {
6f20: 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 set firstblock "
6f30: 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 66 69 72 a$firstblock$fir
6f40: 73 74 62 6c 6f 63 6b 22 7d 0a 20 20 20 20 73 65 stblock"}. se
6f50: 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 22 t secondblock ""
6f60: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
6f70: 30 7d 20 7b 24 69 20 3c 20 31 36 7d 20 7b 69 6e 0} {$i < 16} {in
6f80: 63 72 20 69 7d 20 7b 0a 09 73 65 74 20 73 65 63 cr i} {..set sec
6f90: 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 65 63 6f ondblock "b$seco
6fa0: 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e 64 62 6c ndblock$secondbl
6fb0: 6f 63 6b 22 0a 20 20 20 20 7d 0a 20 20 20 20 73 ock". }. s
6fc0: 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et l [tls::socke
6fd0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
6fe0: 20 32 38 33 32 5d 0a 20 20 20 20 70 72 6f 63 20 2832]. proc
6ff0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
7000: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
7010: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 -blocking 0 -tra
7020: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
7030: 66 65 72 73 69 7a 65 20 31 36 33 38 34 20 5c 0a fersize 16384 \.
7040: 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e ..-buffering lin
7050: 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 e..fileevent $s
7060: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 readable "readab
7070: 6c 65 20 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 le $s". }.
7080: 20 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 7b proc readable {
7090: 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b 67 65 74 s} {..set l [get
70a0: 73 20 24 73 5d 0a 09 66 69 6c 65 65 76 65 6e 74 s $s]..fileevent
70b0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a $s readable {}.
70c0: 09 61 66 74 65 72 20 31 30 30 30 20 72 65 73 70 .after 1000 resp
70d0: 6f 6e 64 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ond $s. }.
70e0: 20 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 proc respond {s
70f0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 66 69 72 73 } {..global firs
7100: 74 62 6c 6f 63 6b 0a 09 70 75 74 73 20 2d 6e 6f tblock..puts -no
7110: 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 newline $s $firs
7120: 74 62 6c 6f 63 6b 0a 09 61 66 74 65 72 20 31 30 tblock..after 10
7130: 30 30 20 77 72 69 74 65 64 61 74 61 20 24 73 0a 00 writedata $s.
7140: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 77 }. proc w
7150: 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 ritedata {s} {..
7160: 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f global secondblo
7170: 63 6b 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c ck..puts -nonewl
7180: 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c ine $s $secondbl
7190: 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 ock..close $s.
71a0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
71b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f ls::socket [info
71c0: 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 32 5d hostname] 2832]
71d0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
71e0: 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d $s -blocking 0 -
71f0: 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 trans lf -buffer
7200: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
7210: 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 count 0. put
7220: 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 70 s $s hello. p
7230: 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b roc readit {s} {
7240: 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 ..global count d
7250: 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 one..set l [read
7260: 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 $s]..incr count
7270: 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 [string length
7280: 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 $l]..if {[eof $s
7290: 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 ]} {.. close
72a0: 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f 6e 65 $s.. set done
72b0: 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 1..}. }.
72c0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
72d0: 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 dable "readit $s
72e0: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
72f0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
7300: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
7310: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e "]. vwait don
7320: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
7330: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
7340: 6f 73 65 20 24 6c 0a 20 20 20 20 73 65 74 20 63 ose $l. set c
7350: 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 ount.} 65566..te
7360: 73 74 20 73 6f 63 6b 65 74 2d 39 2e 33 20 7b 74 st socket-9.3 {t
7370: 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b esting EOF stick
7380: 79 6e 65 73 73 7d 20 7b 73 6f 63 6b 65 74 20 70 yness} {socket p
7390: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 70 72 cCrash} {. pr
73a0: 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 oc count_to_eof
73b0: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f {s} {..global co
73c0: 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 unt done timer..
73d0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
73e0: 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b .if {[eof $s]} {
73f0: 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 .. incr count
7400: 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 .. if {$count
7410: 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 > 9} {...close
7420: 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 72 $s...set done tr
7430: 75 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 7b ue...set count {
7440: 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 eof is sticky}..
7450: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
7460: 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 imer.. }..}.
7470: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 }. proc ti
7480: 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c merproc {} {..gl
7490: 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 obal done count
74a0: 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 c..set done true
74b0: 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d ..set count {tim
74c0: 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 er went off, eof
74d0: 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a is not sticky}.
74e0: 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 .close $c. }.
74f0: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 . set count 0
7500: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 66 61 . set done fa
7510: 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 72 69 lse. proc wri
7520: 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 te_then_close {s
7530: 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 79 65 } {..puts $s bye
7540: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
7550: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
7560: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
7570: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
7580: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
7590: 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 lation lf..filee
75a0: 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 vent $s writable
75b0: 20 22 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f "write_then_clo
75c0: 73 65 20 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 se $s". }.
75d0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
75e0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
75f0: 70 74 20 32 38 33 33 5d 0a 20 20 20 20 73 65 74 pt 2833]. set
7600: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
7610: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
7620: 32 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2833]. fconfi
7630: 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e gure $c -blockin
7640: 67 20 6f 66 66 20 2d 62 75 66 66 65 72 69 6e 67 g off -buffering
7650: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
7660: 6f 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 on lf. fileev
7670: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
7680: 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 "count_to_eof $c
7690: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
76a0: 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 [after 1000 time
76b0: 72 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 rproc]. vwait
76c0: 20 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 done. close
76d0: 24 73 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 $s. set count
76e0: 0a 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b .} {eof is stick
76f0: 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 y}..removeFile s
7700: 63 72 69 70 74 0a 0a 74 65 73 74 20 73 6f 63 6b cript..test sock
7710: 65 74 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e 67 et-10.1 {testing
7720: 20 73 6f 63 6b 65 74 20 61 63 63 65 70 74 20 63 socket accept c
7730: 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 61 allback error ha
7740: 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 20 ndling} {socket
7750: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 pcCrash} {. s
7760: 65 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 et goterror 0.
7770: 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 proc bgerror a
7780: 72 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 rgs {global gote
7790: 72 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 72 rror; set goterr
77a0: 6f 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 20 or 1}. set s
77b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
77c0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 39 38 rver accept 2898
77d0: 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 ]. proc accep
77e0: 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 t {s a p} {close
77f0: 20 24 73 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 $s; error}.
7800: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
7810: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 39 et 127.0.0.1 289
7820: 38 5d 0a 20 20 20 20 76 77 61 69 74 20 67 6f 74 8]. vwait got
7830: 65 72 72 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 error. close
7840: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a $s. close $c.
7850: 20 20 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 set goterror
7860: 0a 7d 20 31 0a 0a 74 65 73 74 20 73 6f 63 6b 65 .} 1..test socke
7870: 74 2d 31 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e t-11.1 {tcp conn
7880: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 ection} {socket
7890: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
78a0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
78b0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
78c0: 74 20 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 t socket9_1_test
78d0: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
78e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
78f0: 65 70 74 20 32 38 33 34 5d 0a 09 70 72 6f 63 20 ept 2834]..proc
7900: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
7910: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 64 6f .. puts $s do
7920: 6e 65 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 ne.. close $s
7930: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
7940: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
7950: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
7960: 20 32 38 33 34 5d 0a 20 20 20 20 73 65 74 20 72 2834]. set r
7970: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
7980: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 lose $s. send
7990: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
79a0: 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 socket9_1_test_s
79b0: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 72 erver}. set r
79c0: 0a 7d 20 64 6f 6e 65 0a 74 65 73 74 20 73 6f 63 .} done.test soc
79d0: 6b 65 74 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 ket-11.2 {client
79e0: 20 73 70 65 63 69 66 69 65 73 20 69 74 73 20 70 specifies its p
79f0: 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ort} {socket doT
7a00: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
7a10: 72 76 65 72 7d 20 7b 0a 20 20 20 20 69 66 20 7b rver} {. if {
7a20: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 [info exists por
7a30: 74 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 6f 72 74 t]} {..incr port
7a40: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
7a50: 65 74 20 70 6f 72 74 20 5b 65 78 70 72 20 32 30 et port [expr 20
7a60: 34 38 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 48 + [pid]%1024]
7a70: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
7a80: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
7a90: 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 cket9_2_test_ser
7aa0: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
7ab0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
7ac0: 32 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 2835]..proc acce
7ad0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
7ae0: 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 puts $s $p..
7af0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 close $s..}.
7b00: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
7b10: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f ls::socket -mypo
7b20: 72 74 20 24 70 6f 72 74 20 24 72 65 6d 6f 74 65 rt $port $remote
7b30: 53 65 72 76 65 72 49 50 20 32 38 33 35 5d 0a 20 ServerIP 2835].
7b40: 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 set r [gets $
7b50: 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a s]. close $s.
7b60: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
7b70: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f {close $socket9_
7b80: 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 2_test_server}.
7b90: 20 20 20 69 66 20 7b 24 72 20 3d 3d 20 24 70 6f if {$r == $po
7ba0: 72 74 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c rt} {..set resul
7bb0: 74 20 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 t ok. } else
7bc0: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 62 72 {..set result br
7bd0: 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 20 20 73 oken. }. s
7be0: 65 74 20 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a 74 et result.} ok.t
7bf0: 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 33 20 est socket-11.3
7c00: 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 {trying to conne
7c10: 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d 20 7b ct, no server} {
7c20: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
7c30: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
7c40: 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 {. set status
7c50: 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 ok. if {![ca
7c60: 74 63 68 20 7b 73 65 74 20 73 20 5b 74 6c 73 3a tch {set s [tls:
7c70: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
7c80: 65 72 76 65 72 49 70 20 32 38 33 36 5d 7d 5d 7d erverIp 2836]}]}
7c90: 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 {..if {![catch
7ca0: 7b 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 {gets $s}]} {..
7cb0: 20 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 set status br
7cc0: 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 oken..}..close $
7cd0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
7ce0: 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 74 65 73 74 status.} ok.test
7cf0: 20 73 6f 63 6b 65 74 2d 31 31 2e 34 20 7b 72 65 socket-11.4 {re
7d00: 6d 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c mote echo, one l
7d10: 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ine} {socket doT
7d20: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
7d30: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
7d40: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
7d50: 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 ocket10_6_test_s
7d60: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
7d70: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
7d80: 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 2836]..proc ac
7d90: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
7da0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
7db0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
7dc0: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
7dd0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
7de0: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
7df0: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d nslation crlf..}
7e00: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
7e10: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
7e20: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b ts $s].. if {
7e30: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
7e40: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
7e50: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 se {...puts $s $
7e60: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 l.. }..}.
7e70: 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 }. set f [tls
7e80: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
7e90: 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 ServerIP 2836].
7ea0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
7eb0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 -translation cr
7ec0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
7ed0: 6e 65 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 ne. puts $f h
7ee0: 65 6c 6c 6f 0a 20 20 20 20 73 65 74 20 72 20 5b ello. set r [
7ef0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
7f00: 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f se $f. sendCo
7f10: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
7f20: 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 cket10_6_test_se
7f30: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a rver}. set r.
7f40: 7d 20 68 65 6c 6c 6f 0a 74 65 73 74 20 73 6f 63 } hello.test soc
7f50: 6b 65 74 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 65 ket-11.5 {remote
7f60: 20 65 63 68 6f 2c 20 35 30 20 6c 69 6e 65 73 7d echo, 50 lines}
7f70: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
7f80: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
7f90: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d } {. sendComm
7fa0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
7fb0: 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 t10_7_test_serve
7fc0: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
7fd0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
7fe0: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
7ff0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
8000: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
8010: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
8020: 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 $s].. fconfi
8030: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
8040: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
8050: 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 tion crlf..}..pr
8060: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
8070: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
8080: 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 s].. if {[eof
8090: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
80a0: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b $s.. } else {
80b0: 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 ...puts $s $l..
80c0: 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 }..}. }.
80d0: 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f set f [tls::so
80e0: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
80f0: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 erIP 2836]. f
8100: 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 configure $f -tr
8110: 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d anslation crlf -
8120: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
8130: 20 20 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 for {set cnt
8140: 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 0} {$cnt < 50} {
8150: 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 incr cnt} {..put
8160: 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e s $f "hello, $cn
8170: 74 22 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 t"..if {[string
8180: 63 6f 6d 70 61 72 65 20 5b 67 65 74 73 20 24 66 compare [gets $f
8190: 5d 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d ] "hello, $cnt"]
81a0: 20 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 != 0} {.. br
81b0: 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 eak..}. }.
81c0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
81d0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
81e0: 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 $socket10_7_tes
81f0: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
8200: 74 20 63 6e 74 0a 7d 20 35 30 0a 23 20 4d 61 63 t cnt.} 50.# Mac
8210: 69 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 intosh sockets c
8220: 61 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 an have more tha
8230: 6e 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 n one server per
8240: 20 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 port.if {$tcl_p
8250: 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d latform(platform
8260: 29 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 ) == "macintosh"
8270: 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 } {. set conf
8280: 6c 69 63 74 52 65 73 75 6c 74 20 7b 30 20 32 38 lictResult {0 28
8290: 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 36}.} else {.
82a0: 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 set conflictRes
82b0: 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 ult {1 {couldn't
82c0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
82d0: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
82e0: 20 75 73 65 7d 7d 0a 7d 0a 74 65 73 74 20 73 6f use}}.}.test so
82f0: 63 6b 65 74 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 cket-11.6 {socke
8300: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 t conflict} {soc
8310: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
8320: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
8330: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
8340: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
8350: 63 63 65 70 74 20 32 38 33 36 5d 0a 20 20 20 20 ccept 2836].
8360: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 if {[catch {set
8370: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
8380: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
8390: 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 836]} msg]} {..s
83a0: 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 et result [list
83b0: 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 1 $msg]. } el
83c0: 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 se {..set result
83d0: 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 [list 0 [lindex
83e0: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 [fconfigure $s2
83f0: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a -sockname] 2]].
8400: 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d .close $s2. }
8410: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
8420: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 set result.}
8430: 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a $conflictResult.
8440: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 37 test socket-11.7
8450: 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 {server with se
8460: 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b veral clients} {
8470: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8480: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
8490: 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e {. sendComman
84a0: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
84b0: 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 20 0_9_test_server
84c0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
84d0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
84e0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
84f0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 63 s a p} {.. fc
8500: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
8510: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
8520: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
8530: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
8540: 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 o $s]..}..proc e
8550: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 cho {s} {.. s
8560: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
8570: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
8580: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
8590: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 } else {...p
85a0: 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d uts $s $l.. }
85b0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
85c0: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
85d0: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
85e0: 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e P 2836]. fcon
85f0: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 figure $s1 -buff
8600: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
8610: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
8620: 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 et $remoteServer
8630: 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 2836]. fco
8640: 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 75 66 nfigure $s2 -buf
8650: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
8660: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
8670: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ket $remoteServe
8680: 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 rIP 2836]. fc
8690: 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 onfigure $s3 -bu
86a0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
86b0: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
86c0: 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 $i < 100} {incr
86d0: 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 i} {..puts $s1 h
86e0: 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 ello,s1..gets $s
86f0: 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 1..puts $s2 hell
8700: 6f 2c 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 o,s2..gets $s2..
8710: 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 puts $s3 hello,s
8720: 33 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 3..gets $s3.
8730: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a }. close $s1.
8740: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
8750: 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 close $s3.
8760: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
8770: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f 74 se $socket10_9_t
8780: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
8790: 73 65 74 20 69 0a 7d 20 31 30 30 20 20 20 20 0a set i.} 100 .
87a0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 38 test socket-11.8
87b0: 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 73 65 {client with se
87c0: 76 65 72 61 6c 20 73 65 72 76 65 72 73 7d 20 7b veral servers} {
87d0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
87e0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
87f0: 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e {. sendComman
8800: 64 20 7b 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 d {..set s1 [tls
8810: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
8820: 20 22 61 63 63 65 70 74 20 34 30 30 33 22 20 34 "accept 4003" 4
8830: 30 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 6c 003]..set s2 [tl
8840: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
8850: 72 20 22 61 63 63 65 70 74 20 34 30 30 34 22 20 r "accept 4004"
8860: 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 5b 74 4004]..set s3 [t
8870: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
8880: 65 72 20 22 61 63 63 65 70 74 20 34 30 30 35 22 er "accept 4005"
8890: 20 34 30 30 35 5d 0a 09 70 72 6f 63 20 61 63 63 4005]..proc acc
88a0: 65 70 74 20 7b 6d 70 20 73 20 61 20 70 7d 20 7b ept {mp s a p} {
88b0: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 24 6d .. puts $s $m
88c0: 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a p.. close $s.
88d0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
88e0: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
88f0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
8900: 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 20 73 4003]. set s
8910: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 2 [tls::socket $
8920: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 remoteServerIP 4
8930: 30 30 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 004]. set s3
8940: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
8950: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
8960: 35 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 5]. set l "".
8970: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 lappend l [g
8980: 65 74 73 20 24 73 31 5d 20 5b 67 65 74 73 20 24 ets $s1] [gets $
8990: 73 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 s1] [eof $s1] [g
89a0: 65 74 73 20 24 73 32 5d 20 5b 67 65 74 73 20 24 ets $s2] [gets $
89b0: 73 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a s2] [eof $s2] \.
89c0: 09 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 65 74 .[gets $s3] [get
89d0: 73 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d s $s3] [eof $s3]
89e0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
89f0: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
8a00: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 close $s3. s
8a10: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c endCommand {..cl
8a20: 6f 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 ose $s1..close $
8a30: 73 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 s2..close $s3.
8a40: 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 }. set l.}
8a50: 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 34 20 {4003 {} 1 4004
8a60: 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a {} 1 4005 {} 1}.
8a70: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 39 test socket-11.9
8a80: 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 {accept callbac
8a90: 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 k error} {socket
8aa0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
8ab0: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
8ac0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
8ad0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
8ae0: 74 20 32 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 t 2836]. proc
8af0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
8b00: 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 {expr 10 / 0}.
8b10: 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 proc bgerror a
8b20: 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a rgs {..global x.
8b30: 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 .set x $args.
8b40: 20 7d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 }. if {[catc
8b50: 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b h {sendCommand {
8b60: 0a 09 20 20 20 20 73 65 74 20 70 65 65 72 6e 61 .. set peerna
8b70: 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 me [fconfigure $
8b80: 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 2d 70 65 callerSocket -pe
8b90: 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 73 65 74 ername].. set
8ba0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
8bb0: 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 6e 61 6d [lindex $peernam
8bc0: 65 20 30 5d 20 32 38 33 36 5d 0a 09 20 20 20 20 e 0] 2836]..
8bd0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 20 7d close $s. . }
8be0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 65 } msg]} {..close
8bf0: 20 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 67 0a $s..error $msg.
8c00: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 69 }. set ti
8c10: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
8c20: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
8c30: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
8c40: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
8c50: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
8c60: 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 e $s. rename
8c70: 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 bgerror {}. s
8c80: 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 et x.} {{divide
8c90: 62 79 20 7a 65 72 6f 7d 7d 0a 74 65 73 74 20 73 by zero}}.test s
8ca0: 6f 63 6b 65 74 2d 31 31 2e 31 30 20 7b 74 65 73 ocket-11.10 {tes
8cb0: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
8cc0: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 ific options} {s
8cd0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
8ce0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
8cf0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8d00: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
8d10: 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 _12_test_server
8d20: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
8d30: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
8d40: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
8d50: 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 s a p} {close $s
8d60: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
8d70: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 s [tls::socket $
8d80: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
8d90: 38 33 36 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 836]. set p [
8da0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 fconfigure $s -p
8db0: 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 eername]. set
8dc0: 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 n [fconfigure $
8dd0: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 s -sockname].
8de0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
8df0: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
8e00: 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 $p 2] [llength $
8e10: 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a p] [llength $p].
8e20: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
8e30: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
8e40: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 ose $socket10_12
8e50: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
8e60: 20 20 73 65 74 20 6c 0a 7d 20 7b 32 38 33 36 20 set l.} {2836
8e70: 33 20 33 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 3 3}.test socket
8e80: 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 -11.11 {testing
8e90: 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d spurious events}
8ea0: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
8eb0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
8ec0: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d } {. sendComm
8ed0: 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 and {..set socke
8ee0: 74 31 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 t10_13_test_serv
8ef0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
8f00: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
8f10: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
8f20: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
8f30: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
8f40: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 translation "aut
8f50: 6f 20 6c 66 22 0a 09 20 20 20 20 61 66 74 65 72 o lf".. after
8f60: 20 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 24 100 writesome $
8f70: 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 s..}..proc write
8f80: 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 some {s} {..
8f90: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
8fa0: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
8fb0: 7d 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 6c } {...puts $s "l
8fc0: 69 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f ine $i from remo
8fd0: 74 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 20 te server"..
8fe0: 7d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a }.. close $s.
8ff0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
9000: 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 len 0. set s
9010: 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 purious 0. se
9020: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f t done 0. pro
9030: 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d c readlittle {s}
9040: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 {..global spuri
9050: 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 ous done len..se
9060: 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a t l [read $s 1].
9070: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e .if {[string len
9080: 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a gth $l] == 0} {.
9090: 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 . if {![eof $
90a0: 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 s]} {...incr spu
90b0: 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 rious.. } els
90c0: 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 e {...close $s..
90d0: 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 .set done 1..
90e0: 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 }..} else {..
90f0: 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 incr len [stri
9100: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d ng length $l]..}
9110: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 . }. set c
9120: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 [tls::socket $r
9130: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 emoteServerIP 28
9140: 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 36]. fileeven
9150: 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 72 t $c readable "r
9160: 65 61 64 6c 69 74 74 6c 65 20 24 63 22 0a 20 20 eadlittle $c".
9170: 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 set timer [aft
9180: 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f er 10000 "set do
9190: 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 ne timed_out"].
91a0: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
91b0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
91c0: 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 6f timer. sendCo
91d0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
91e0: 63 6b 65 74 31 30 5f 31 33 5f 74 65 73 74 5f 73 cket10_13_test_s
91f0: 65 72 76 65 72 7d 0a 20 20 20 20 6c 69 73 74 20 erver}. list
9200: 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d $spurious $len.}
9210: 20 7b 30 20 32 36 39 30 7d 0a 74 65 73 74 20 73 {0 2690}.test s
9220: 6f 63 6b 65 74 2d 31 31 2e 31 32 20 7b 74 65 73 ocket-11.12 {tes
9230: 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e ting EOF stickyn
9240: 65 73 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ess} {socket doT
9250: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9260: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 rver} {. set
9270: 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 73 65 counter 0. se
9280: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f t done 0. pro
9290: 63 20 63 6f 75 6e 74 5f 75 70 20 7b 73 7d 20 7b c count_up {s} {
92a0: 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 65 72 ..global counter
92b0: 20 64 6f 6e 65 20 61 66 74 65 72 5f 69 64 0a 09 done after_id..
92c0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
92d0: 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b .if {[eof $s]} {
92e0: 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 .. incr count
92f0: 65 72 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 er.. if {$cou
9300: 6e 74 65 72 20 3e 20 39 7d 20 7b 0a 09 09 73 65 nter > 9} {...se
9310: 74 20 64 6f 6e 65 20 7b 45 4f 46 20 69 73 20 73 t done {EOF is s
9320: 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 ticky}...after c
9330: 61 6e 63 65 6c 20 24 61 66 74 65 72 5f 69 64 0a ancel $after_id.
9340: 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 ..close $s..
9350: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 }..}. }. p
9360: 72 6f 63 20 74 69 6d 65 64 5f 6f 75 74 20 7b 7d roc timed_out {}
9370: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 20 64 6f 6e {..global c don
9380: 65 0a 09 73 65 74 20 64 6f 6e 65 20 7b 74 69 6d e..set done {tim
9390: 65 64 5f 6f 75 74 2c 20 45 4f 46 20 69 73 20 6e ed_out, EOF is n
93a0: 6f 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 ot sticky}..clos
93b0: 65 20 24 63 0a 20 20 20 20 7d 0a 20 20 20 20 73 e $c. }. s
93c0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
93d0: 74 20 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 t socket10_14_te
93e0: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
93f0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
9400: 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f ccept 2836]..pro
9410: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
9420: 20 7b 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 {.. after 10
9430: 30 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 0 close $s..}.
9440: 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 }. set c [t
9450: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
9460: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d teServerIP 2836]
9470: 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
9480: 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e c readable "coun
9490: 74 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 74 t_up $c". set
94a0: 20 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 72 after_id [after
94b0: 20 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 1000 timed_out]
94c0: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
94d0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
94e0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
94f0: 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _14_test_server}
9500: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 . set done.}
9510: 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a {EOF is sticky}.
9520: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 test socket-11.1
9530: 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 3 {testing async
9540: 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 6c write, async fl
9550: 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 ush, async close
9560: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
9570: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9580: 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 rver} {. proc
9590: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
95a0: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
95b0: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
95c0: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
95d0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
95e0: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
95f0: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
9600: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
9610: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e .}. }. sen
9620: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
9630: 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a 09 66 firstblock ""..f
9640: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
9650: 20 3c 20 35 7d 20 7b 69 6e 63 72 20 69 7d 20 7b < 5} {incr i} {
9660: 0a 09 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 ...set firstbloc
9670: 6b 20 22 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 k "a$firstblock$
9680: 66 69 72 73 74 62 6c 6f 63 6b 22 0a 09 7d 0a 09 firstblock"..}..
9690: 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 set secondblock
96a0: 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 ""..for {set i 0
96b0: 7d 20 7b 24 69 20 3c 20 31 36 7d 20 7b 69 6e 63 } {$i < 16} {inc
96c0: 72 20 69 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 r i} {.. set
96d0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 secondblock "b$s
96e0: 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e econdblock$secon
96f0: 64 62 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 dblock"..}..set
9700: 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d l [tls::socket -
9710: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
9720: 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 45]..proc accept
9730: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
9740: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
9750: 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 locking 0 -trans
9760: 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 lation lf -buffe
9770: 72 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 rsize 16384 \...
9780: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
9790: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
97a0: 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 s readable "read
97b0: 61 62 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f able $s"..}..pro
97c0: 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b c readable {s} {
97d0: 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 .. set l [get
97e0: 73 20 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 s $s].. filee
97f0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
9800: 20 7b 7d 0a 09 20 20 20 20 61 66 74 65 72 20 31 {}.. after 1
9810: 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 000 respond $s..
9820: 7d 0a 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 }..proc respond
9830: 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 {s} {.. globa
9840: 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 l firstblock..
9850: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
9860: 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b e $s $firstblock
9870: 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 .. after 1000
9880: 20 77 72 69 74 65 64 61 74 61 20 24 73 0a 09 7d writedata $s..}
9890: 0a 09 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 ..proc writedata
98a0: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 {s} {.. glob
98b0: 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 al secondblock..
98c0: 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c puts -nonewl
98d0: 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c ine $s $secondbl
98e0: 6f 63 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 ock.. close $
98f0: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
9900: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
9910: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
9920: 50 20 32 38 34 35 5d 0a 20 20 20 20 66 63 6f 6e P 2845]. fcon
9930: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
9940: 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 ing 0 -trans lf
9950: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
9960: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a set count 0.
9970: 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c puts $s hell
9980: 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 o. fileevent
9990: 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $s readable "rea
99a0: 64 69 74 20 24 73 22 0a 20 20 20 20 73 65 74 20 dit $s". set
99b0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
99c0: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
99d0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
99e0: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
99f0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
9a00: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9a10: 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 20 20 73 {close $l}. s
9a20: 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 36 36 et count.} 65566
9a30: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 32 ..test socket-12
9a40: 2e 31 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 .1 {testing inhe
9a50: 72 69 74 61 6e 63 65 20 6f 66 20 73 65 72 76 65 ritance of serve
9a60: 72 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 r sockets} \..{s
9a70: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
9a80: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
9a90: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
9aa0: 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f script1. remo
9ab0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 0a veFile script2..
9ac0: 20 20 20 20 23 20 53 63 72 69 70 74 31 20 69 73 # Script1 is
9ad0: 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e just a 10 secon
9ae0: 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 d delay. If the
9af0: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 server socket.
9b00: 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 # is inherite
9b10: 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 d, it will be he
9b20: 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 ld open for 10 s
9b30: 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 econds.. set
9b40: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 f [open script1
9b50: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
9b60: 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 ..after 10000 ex
9b70: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
9b80: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
9b90: 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 e $f.. # Scri
9ba0: 70 74 32 20 63 72 65 61 74 65 73 20 74 68 65 20 pt2 creates the
9bb0: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c server socket, l
9bc0: 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 2c aunches script1,
9bd0: 0a 20 20 20 20 23 20 77 61 69 74 73 20 61 20 73 . # waits a s
9be0: 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 econd, and exits
9bf0: 2e 20 20 54 68 65 20 73 65 72 76 65 72 20 73 6f . The server so
9c00: 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 cket will now.
9c10: 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20 75 6e # be closed un
9c20: 6c 65 73 73 20 73 63 72 69 70 74 31 20 69 6e 68 less script1 inh
9c30: 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 erited it...
9c40: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
9c50: 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt2 w]. puts
9c60: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c $f [list set tcl
9c70: 74 65 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a test $::tcltest:
9c80: 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 :tcltest]. pu
9c90: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
9ca0: 20 72 65 71 75 69 72 65 20 74 63 6c 74 65 73 74 require tcltest
9cb0: 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f ..set f [tls::so
9cc0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
9cd0: 65 70 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 ept 2828]..proc
9ce0: 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 61 64 accept { file ad
9cf0: 64 72 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 dr port } {..
9d00: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
9d10: 09 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 .exec $::tcltest
9d20: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
9d30: 31 20 26 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 1 &..close $f..a
9d40: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
9d50: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
9d60: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
9d70: 0a 09 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 ... # Launch
9d80: 73 63 72 69 70 74 32 20 61 6e 64 20 77 61 69 74 script2 and wait
9d90: 20 35 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 5 seconds..
9da0: 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a exec $::tcltest:
9db0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 :tcltest script2
9dc0: 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 &. after 500
9dd0: 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 0 { set ok_to_pr
9de0: 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 76 77 oceed 1 }. vw
9df0: 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 ait ok_to_procee
9e00: 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 20 63 d.. # If we c
9e10: 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 an still connect
9e20: 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 2c 20 to the server,
9e30: 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 69 the socket got i
9e40: 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 69 nherited... i
9e50: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
9e60: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
9e70: 20 32 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 2828} msg]} {..
9e80: 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f set x {server so
9e90: 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 cket was not inh
9ea0: 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 20 65 6c erited}. } el
9eb0: 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 se {..close $msg
9ec0: 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 ..set x {server
9ed0: 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 socket was inher
9ee0: 69 74 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 ited}. }..
9ef0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
9f00: 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 pt1. removeFi
9f10: 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 le script2. s
9f20: 65 74 20 78 0a 7d 20 7b 73 65 72 76 65 72 20 73 et x.} {server s
9f30: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
9f40: 68 65 72 69 74 65 64 7d 0a 74 65 73 74 20 73 6f herited}.test so
9f50: 63 6b 65 74 2d 31 32 2e 32 20 7b 74 65 73 74 69 cket-12.2 {testi
9f60: 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f ng inheritance o
9f70: 66 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 73 f client sockets
9f80: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
9f90: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9fa0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rver} {. remo
9fb0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 veFile script1.
9fc0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
9fd0: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
9fe0: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
9ff0: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
a000: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
a010: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
a020: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
a030: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
a040: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
a050: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
a060: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
a070: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
a080: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
a090: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
a0a0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
a0b0: 20 23 20 53 63 72 69 70 74 32 20 6f 70 65 6e 73 # Script2 opens
a0c0: 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b the client sock
a0d0: 65 74 20 61 6e 64 20 77 72 69 74 65 73 20 74 6f et and writes to
a0e0: 20 69 74 2e 20 20 49 74 20 74 68 65 6e 0a 20 20 it. It then.
a0f0: 20 20 23 20 6c 61 75 6e 63 68 65 73 20 73 63 72 # launches scr
a100: 69 70 74 31 20 61 6e 64 20 65 78 69 74 73 2e 20 ipt1 and exits.
a110: 20 49 66 20 74 68 65 20 63 68 69 6c 64 20 70 72 If the child pr
a120: 6f 63 65 73 73 20 69 6e 68 65 72 69 74 65 64 20 ocess inherited
a130: 74 68 65 0a 20 20 20 20 23 20 63 6c 69 65 6e 74 the. # client
a140: 20 73 6f 63 6b 65 74 2c 20 74 68 65 20 73 6f 63 socket, the soc
a150: 6b 65 74 20 77 69 6c 6c 20 73 74 69 6c 6c 20 62 ket will still b
a160: 65 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 73 65 74 e open... set
a170: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 f [open script2
a180: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
a190: 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 74 65 73 [list set tcltes
a1a0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
a1b0: 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 ltest]. puts
a1c0: 24 66 20 7b 0a 09 73 65 74 20 66 20 5b 74 6c 73 $f {..set f [tls
a1d0: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
a1e0: 2e 31 20 32 38 32 39 5d 0a 09 65 78 65 63 20 24 .1 2829]..exec $
a1f0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
a200: 73 74 20 73 63 72 69 70 74 31 20 26 0a 09 70 75 st script1 &..pu
a210: 74 73 20 24 66 20 74 65 73 74 69 6e 67 0a 09 66 ts $f testing..f
a220: 6c 75 73 68 20 24 66 0a 09 61 66 74 65 72 20 31 lush $f..after 1
a230: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
a240: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
a250: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
a260: 23 20 43 72 65 61 74 65 20 74 68 65 20 73 65 72 # Create the ser
a270: 76 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 ver socket..
a280: 73 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 3a set server [tls:
a290: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
a2a0: 61 63 63 65 70 74 20 32 38 32 39 5d 0a 20 20 20 accept 2829].
a2b0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 proc accept { f
a2c0: 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 ile host port }
a2d0: 7b 0a 0a 09 23 20 57 68 65 6e 20 74 68 65 20 63 {...# When the c
a2e0: 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 2c 20 lient connects,
a2f0: 65 73 74 61 62 6c 69 73 68 20 74 68 65 20 72 65 establish the re
a300: 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c 6f 62 ad handler..glob
a310: 61 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f 73 65 al server..close
a320: 20 24 73 65 72 76 65 72 0a 09 66 69 6c 65 65 76 $server..fileev
a330: 65 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 62 ent $file readab
a340: 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 61 le [list getdata
a350: 20 24 66 69 6c 65 5d 0a 09 66 63 6f 6e 66 69 67 $file]..fconfig
a360: 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 66 65 ure $file -buffe
a370: 72 69 6e 67 20 6c 69 6e 65 20 2d 62 6c 6f 63 6b ring line -block
a380: 69 6e 67 20 30 0a 09 72 65 74 75 72 6e 0a 20 20 ing 0..return.
a390: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 67 65 74 }. proc get
a3a0: 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a data { file } {.
a3b0: 0a 09 23 20 52 65 61 64 20 68 61 6e 64 6c 65 72 ..# Read handler
a3c0: 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 65 64 on the accepted
a3d0: 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 6c socket...global
a3e0: 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c 65 x..global faile
a3f0: 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b 63 d..set status [c
a400: 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c 65 atch {read $file
a410: 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 74 } data]..if {$st
a420: 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 20 atus != 0} {..
a430: 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 66 61 set x {read fa
a440: 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 20 iled, error was
a450: 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 74 63 $data}.. catc
a460: 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 h { close $file
a470: 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 }..} elseif {[st
a480: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 ring compare {}
a490: 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c 73 $data]} {..} els
a4a0: 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 24 eif {[fblocked $
a4b0: 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 file]} {..} else
a4c0: 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d 7d if {[eof $file]}
a4d0: 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 69 {.. if {$fai
a4e0: 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 7b led} {...set x {
a4f0: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 client socket wa
a500: 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 s inherited}..
a510: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 } else {...set
a520: 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 x {client socke
a530: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
a540: 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 ted}.. }..
a550: 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 catch { close $
a560: 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b file }..} else {
a570: 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 6d 70 .. set x {imp
a580: 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 ossible case}..
a590: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
a5a0: 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 $file }..}..ret
a5b0: 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 urn. }.. #
a5c0: 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 64 If the socket d
a5d0: 6f 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f oesn't hit end-o
a5e0: 66 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 6f f-file in 5 seco
a5f0: 6e 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 73 nds, the. # s
a600: 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 6d cript1 process m
a610: 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 ust have inherit
a620: 65 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a ed the client...
a630: 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 30 set failed 0
a640: 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 . after 5000
a650: 5b 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 64 [list set failed
a660: 20 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 1].. # Launc
a670: 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 h the script2 pr
a680: 6f 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 20 ocess.. exec
a690: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
a6a0: 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 est script2 &..
a6b0: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 69 vwait x. i
a6c0: 66 20 7b 21 24 66 61 69 6c 65 64 7d 20 7b 0a 09 f {!$failed} {..
a6d0: 76 77 61 69 74 20 66 61 69 6c 65 64 0a 20 20 20 vwait failed.
a6e0: 20 7d 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c }. removeFil
a6f0: 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 e script1. re
a700: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 moveFile script2
a710: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6c . set x.} {cl
a720: 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 ient socket was
a730: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 74 not inherited}.t
a740: 65 73 74 20 73 6f 63 6b 65 74 2d 31 32 2e 33 20 est socket-12.3
a750: 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 {testing inherit
a760: 61 6e 63 65 20 6f 66 20 61 63 63 65 70 74 65 64 ance of accepted
a770: 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f sockets} \..{so
a780: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
a790: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
a7a0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
a7b0: 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 cript1. remov
a7c0: 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 eFile script2..
a7d0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
a7e0: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
a7f0: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
a800: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
a810: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
a820: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
a830: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
a840: 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt2 w]. puts
a850: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 $f [list set tc
a860: 6c 74 65 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 ltest $::tcltest
a870: 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 ::tcltest]. p
a880: 75 74 73 20 24 66 20 7b 0a 09 73 65 74 20 73 65 uts $f {..set se
a890: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
a8a0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
a8b0: 20 32 39 33 30 5d 0a 09 70 72 6f 63 20 61 63 63 2930]..proc acc
a8c0: 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 ept { file host
a8d0: 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c port } {.. gl
a8e0: 6f 62 61 6c 20 74 63 6c 74 65 73 74 0a 09 20 20 obal tcltest..
a8f0: 20 20 70 75 74 73 20 24 66 69 6c 65 20 7b 74 65 puts $file {te
a900: 73 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 st data on socke
a910: 74 7d 0a 09 20 20 20 20 65 78 65 63 20 24 3a 3a t}.. exec $::
a920: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
a930: 20 73 63 72 69 70 74 31 20 26 0a 09 20 20 20 20 script1 &..
a940: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
a950: 09 7d 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 .}..vwait foreve
a960: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
a970: 65 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e e $f.. # Laun
a980: 63 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 ch the script2 p
a990: 72 6f 63 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 rocess and conne
a9a0: 63 74 20 74 6f 20 69 74 2e 20 20 53 65 65 20 68 ct to it. See h
a9b0: 6f 77 20 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 ow long. # th
a9c0: 65 20 73 6f 63 6b 65 74 20 73 74 61 79 73 20 6f e socket stays o
a9d0: 70 65 6e 0a 0a 20 20 20 20 65 78 65 63 20 24 3a pen.. exec $:
a9e0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
a9f0: 74 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 t script2 &..
aa00: 20 61 66 74 65 72 20 31 30 30 30 20 73 65 74 20 after 1000 set
aa10: 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a ok_to_proceed 1.
aa20: 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f vwait ok_to_
aa30: 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 73 65 74 proceed.. set
aa40: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
aa50: 31 32 37 2e 30 2e 30 2e 31 20 32 39 33 30 5d 0a 127.0.0.1 2930].
aa60: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
aa70: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 66 75 6c f -buffering ful
aa80: 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 l -blocking 0.
aa90: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 66 20 72 fileevent $f r
aaa0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 eadable [list ge
aab0: 74 64 61 74 61 20 24 66 5d 0a 0a 20 20 20 20 23 tdata $f].. #
aac0: 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 69 If the socket i
aad0: 73 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 66 74 s still open aft
aae0: 65 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 er 5 seconds, th
aaf0: 65 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 e script1 proces
ab00: 73 0a 20 20 20 20 23 20 6d 75 73 74 20 68 61 76 s. # must hav
ab10: 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 e inherited the
ab20: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e accepted socket.
ab30: 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 .. set failed
ab40: 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0. after 500
ab50: 30 20 73 65 74 20 66 61 69 6c 65 64 20 31 0a 0a 0 set failed 1..
ab60: 20 20 20 20 70 72 6f 63 20 67 65 74 64 61 74 61 proc getdata
ab70: 20 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 20 { file } {...#
ab80: 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 Read handler on
ab90: 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 the client socke
aba0: 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 67 6c t...global x..gl
abb0: 6f 62 61 6c 20 66 61 69 6c 65 64 0a 09 73 65 74 obal failed..set
abc0: 20 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 7b status [catch {
abd0: 72 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 61 read $file} data
abe0: 5d 0a 09 69 66 20 7b 24 73 74 61 74 75 73 20 21 ]..if {$status !
abf0: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 = 0} {.. set
ac00: 78 20 7b 72 65 61 64 20 66 61 69 6c 65 64 2c 20 x {read failed,
ac10: 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 61 7d error was $data}
ac20: 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c .. catch { cl
ac30: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 ose $file }..} e
ac40: 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 lseif {[string c
ac50: 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 61 5d ompare {} $data]
ac60: 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b } {..} elseif {[
ac70: 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d fblocked $file]}
ac80: 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 65 {..} elseif {[e
ac90: 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 of $file]} {..
aca0: 20 20 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b if {$failed} {
acb0: 0a 09 09 73 65 74 20 78 20 7b 61 63 63 65 70 74 ...set x {accept
acc0: 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 69 6e ed socket was in
acd0: 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d 20 herited}.. }
ace0: 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 20 7b else {...set x {
acf0: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 accepted socket
ad00: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
ad10: 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 d}.. }.. c
ad20: 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 atch { close $fi
ad30: 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 le }..} else {..
ad40: 20 20 20 20 73 65 74 20 78 20 7b 69 6d 70 6f 73 set x {impos
ad50: 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 20 sible case}..
ad60: 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 catch { close $
ad70: 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 72 file }..}..retur
ad80: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 0a 20 20 20 n. }. .
ad90: 20 76 77 61 69 74 20 78 0a 0a 20 20 20 20 72 65 vwait x.. re
ada0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 moveFile script1
adb0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
adc0: 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 script2. set
add0: 78 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 73 6f x.} {accepted so
ade0: 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 cket was not inh
adf0: 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 73 6f erited}..test so
ae00: 63 6b 65 74 2d 31 33 2e 31 20 7b 54 65 73 74 69 cket-13.1 {Testi
ae10: 6e 67 20 75 73 65 20 6f 66 20 73 68 61 72 65 64 ng use of shared
ae20: 20 73 6f 63 6b 65 74 20 62 65 74 77 65 65 6e 20 socket between
ae30: 74 77 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a 09 two threads} \..
ae40: 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 68 72 65 {socket testthre
ae50: 61 64 7d 20 7b 0a 0a 20 20 20 20 72 65 6d 6f 76 ad} {.. remov
ae60: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
ae70: 20 74 68 72 65 61 64 52 65 61 70 0a 0a 20 20 20 threadReap..
ae80: 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 20 makeFile {.
ae90: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
aea0: 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 tls..set f [tls
aeb0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
aec0: 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 70 accept 2828]..p
aed0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
aee0: 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 p} {.
aef0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
af00: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
af10: 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 o $s].
af20: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
af30: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
af40: 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 }..proc
af50: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
af60: 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 global i.
af70: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
af80: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ts $s].
af90: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
afa0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
afb0: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
afc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
afd0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 lose $s.
afe0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
aff0: 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 one.
b000: 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 } else { ..
b010: 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 incr i.
b020: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 put
b030: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
b040: 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 }..}..set i
b050: 20 30 0a 09 76 77 61 69 74 20 78 0a 09 63 6c 6f 0..vwait x..clo
b060: 73 65 20 24 66 0a 0a 09 23 20 74 68 72 65 61 64 se $f...# thread
b070: 20 63 6c 65 61 6e 73 20 69 74 73 65 6c 66 20 75 cleans itself u
b080: 70 2e 0a 09 74 65 73 74 74 68 72 65 61 64 20 65 p...testthread e
b090: 78 69 74 0a 20 20 20 20 7d 20 73 63 72 69 70 74 xit. } script
b0a0: 0a 20 20 20 20 0a 20 20 20 20 23 20 63 72 65 61 . . # crea
b0b0: 74 65 20 61 20 74 68 72 65 61 64 0a 20 20 20 20 te a thread.
b0c0: 73 65 74 20 73 65 72 76 65 72 74 68 72 65 61 64 set serverthread
b0d0: 20 5b 74 65 73 74 74 68 72 65 61 64 20 63 72 65 [testthread cre
b0e0: 61 74 65 20 7b 20 73 6f 75 72 63 65 20 73 63 72 ate { source scr
b0f0: 69 70 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 61 ipt } ]. upda
b100: 74 65 0a 20 20 20 20 0a 20 20 20 20 61 66 74 65 te. . afte
b110: 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 73 r 1000. set s
b120: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
b130: 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 7.0.0.1 2828].
b140: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
b150: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
b160: 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 70 75 . catch {..pu
b170: 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 0a 09 67 ts $s "hello"..g
b180: 65 74 73 20 24 73 20 72 65 73 75 6c 74 0a 20 20 ets $s result.
b190: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
b1a0: 0a 20 20 20 20 75 70 64 61 74 65 0a 0a 20 20 20 . update..
b1b0: 20 61 66 74 65 72 20 32 30 30 30 0a 20 20 20 20 after 2000.
b1c0: 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b lappend result [
b1d0: 74 68 72 65 61 64 52 65 61 70 5d 0a 20 20 20 20 threadReap].
b1e0: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
b1f0: 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 20 .} {hello 1}..#
b200: 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 72 cleanup.if {[str
b210: 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a 20 ing match sock*
b220: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 20 $commandSocket]
b230: 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 20 == 1} {. puts
b240: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 65 $commandSocket e
b250: 78 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 6f xit. flush $co
b260: 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 61 mmandSocket.}.ca
b270: 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d tch {close $comm
b280: 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 68 andSocket}.catch
b290: 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 50 {close $remoteP
b2a0: 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 65 rocChan}.::tclte
b2b0: 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 73 st::cleanupTests
b2c0: 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 65 .flush stdout.re
b2d0: 74 75 72 6e 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a turn............