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 37 20 32 30 30 30 2f 30 36 2f 30 33 20 30 30 .7 2000/06/03 00
0210: 3a 32 30 3a 30 32 20 61 77 62 20 45 78 70 20 24 :20:02 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 5c 0a 09 20 20 20 s::socket \..
12e0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
12f0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
1300: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
1310: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
1320: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
1330: 50 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 P \.. $remote
1340: 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d 20 21 3d ServerPort]}] !=
1350: 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 6f 0} {..if {[info
1360: 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d 20 commands exec]
1370: 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 73 65 == ""} {.. se
1380: 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 t noRemoteTestRe
1390: 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 78 65 63 ason "can't exec
13a0: 22 0a 09 20 20 20 20 73 65 74 20 64 6f 54 65 73 ".. set doTes
13b0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
13c0: 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 er 0..} else {..
13d0: 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 set remoteSe
13e0: 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 rverIP 127.0.0.1
13f0: 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 .. set remote
1400: 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 File [file join
1410: 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e 74 63 6c [pwd] remote.tcl
1420: 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 74 63 ].. if {[catc
1430: 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 50 72 6f h {set remotePro
1440: 63 43 68 61 6e 20 5c 0a 09 09 09 09 5b 6f 70 65 cChan \.....[ope
1450: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
1460: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 24 72 test::tcltest $r
1470: 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 09 09 09 emoteFile \.....
1480: 09 2d 73 65 72 76 65 72 49 73 53 69 6c 65 6e 74 .-serverIsSilent
1490: 20 5c 0a 09 09 09 09 09 2d 70 6f 72 74 20 24 72 \......-port $r
14a0: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 emoteServerPort
14b0: 5c 0a 09 09 09 09 09 2d 61 64 64 72 65 73 73 20 \......-address
14c0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d $remoteServerIP]
14d0: 22 20 5c 0a 09 09 09 09 09 77 2b 5d 7d 20 5c 0a " \......w+]} \.
14e0: 09 09 20 20 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 .. msg] == 0}
14f0: 7b 0a 09 09 61 66 74 65 72 20 31 30 30 30 0a 09 {...after 1000..
1500: 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 .if {[catch {set
1510: 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b commandSocket [
1520: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
1530: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
1540: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
1550: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
1560: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
1570: 09 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 65 ....$remoteServe
1580: 72 49 50 20 5c 0a 09 09 09 09 24 72 65 6d 6f 74 rIP \.....$remot
1590: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 6d 73 eServerPort]} ms
15a0: 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 g] == 0} {...
15b0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d fconfigure $com
15c0: 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e mandSocket -tran
15d0: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
15e0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 09 7d ffering line...}
15f0: 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 73 65 else {... se
1600: 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 t noRemoteTestRe
1610: 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 20 20 ason $msg...
1620: 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 set doTestsWithR
1630: 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 09 emoteServer 0...
1640: 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a }.. } else {.
1650: 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 ..set noRemoteTe
1660: 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 20 24 stReason "$msg $
1670: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
1680: 73 74 22 0a 09 09 73 65 74 20 64 6f 54 65 73 74 st"...set doTest
1690: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
16a0: 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 r 0.. }..}.
16b0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 6f 6e } else {..fcon
16c0: 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 figure $commandS
16d0: 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 ocket -translati
16e0: 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 on crlf -bufferi
16f0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d 0a ng line. }.}.
1700: 70 75 74 73 20 73 74 64 6f 75 74 20 22 63 6f 6d puts stdout "com
1710: 6d 61 6e 64 53 6f 63 6b 65 74 3a 20 24 63 6f 6d mandSocket: $com
1720: 6d 61 6e 64 53 6f 63 6b 65 74 22 0a 0a 23 20 53 mandSocket"..# S
1730: 6f 6d 65 20 74 65 73 74 73 20 61 72 65 20 72 75 ome tests are ru
1740: 6e 20 6f 6e 6c 79 20 69 66 20 77 65 20 61 72 65 n only if we are
1750: 20 64 6f 69 6e 67 20 74 65 73 74 69 6e 67 20 61 doing testing a
1760: 67 61 69 6e 73 74 20 61 20 72 65 6d 6f 74 65 20 gainst a remote
1770: 73 65 72 76 65 72 2e 0a 73 65 74 20 3a 3a 74 63 server..set ::tc
1780: 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 ltest::testConst
1790: 72 61 69 6e 74 73 28 64 6f 54 65 73 74 73 57 69 raints(doTestsWi
17a0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 29 20 thRemoteServer)
17b0: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
17c0: 74 65 53 65 72 76 65 72 0a 69 66 20 7b 24 64 6f teServer.if {$do
17d0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
17e0: 65 72 76 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 erver == 0} {.
17f0: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 if {[string fi
1800: 72 73 74 20 73 20 24 3a 3a 74 63 6c 74 65 73 74 rst s $::tcltest
1810: 3a 3a 76 65 72 62 6f 73 65 5d 20 21 3d 20 2d 31 ::verbose] != -1
1820: 7d 20 7b 0a 20 20 20 20 09 70 75 74 73 20 22 53 } {. .puts "S
1830: 6b 69 70 70 69 6e 67 20 74 65 73 74 73 20 77 69 kipping tests wi
1840: 74 68 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 th remote server
1850: 2e 20 53 65 65 20 74 65 73 74 73 2f 73 6f 63 6b . See tests/sock
1860: 65 74 2e 74 65 73 74 20 66 6f 72 22 0a 09 70 75 et.test for"..pu
1870: 74 73 20 22 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 ts "information
1880: 6f 6e 20 68 6f 77 20 74 6f 20 72 75 6e 20 72 65 on how to run re
1890: 6d 6f 74 65 20 73 65 72 76 65 72 2e 22 0a 09 70 mote server."..p
18a0: 75 74 73 20 22 52 65 61 73 6f 6e 20 66 6f 72 20 uts "Reason for
18b0: 6e 6f 74 20 64 6f 69 6e 67 20 72 65 6d 6f 74 65 not doing remote
18c0: 20 74 65 73 74 73 3a 20 24 6e 6f 52 65 6d 6f 74 tests: $noRemot
18d0: 65 54 65 73 74 52 65 61 73 6f 6e 22 0a 20 20 20 eTestReason".
18e0: 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 77 65 20 }.}..#.# If we
18f0: 64 6f 20 74 68 65 20 74 65 73 74 73 2c 20 64 65 do the tests, de
1900: 66 69 6e 65 20 61 20 63 6f 6d 6d 61 6e 64 20 74 fine a command t
1910: 6f 20 73 65 6e 64 20 61 20 63 6f 6d 6d 61 6e 64 o send a command
1920: 20 74 6f 20 74 68 65 0a 23 20 72 65 6d 6f 74 65 to the.# remote
1930: 20 73 65 72 76 65 72 2e 0a 23 0a 0a 69 66 20 7b server..#..if {
1940: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
1950: 74 65 53 65 72 76 65 72 20 3d 3d 20 31 7d 20 7b teServer == 1} {
1960: 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 43 6f . proc sendCo
1970: 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 67 6c 6f mmand {c} {..glo
1980: 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 bal commandSocke
1990: 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 24 63 6f t...if {[eof $co
19a0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a mmandSocket]} {.
19b0: 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f . error "remo
19c0: 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 te server disapp
19d0: 65 61 72 65 64 22 0a 09 7d 0a 0a 09 69 66 20 7b eared"..}...if {
19e0: 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f [catch {puts $co
19f0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 24 63 7d 20 mmandSocket $c}
1a00: 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 msg]} {.. err
1a10: 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 or "remote serve
1a20: 72 20 64 69 73 61 70 70 61 65 72 65 64 3a 20 24 r disappaered: $
1a30: 6d 73 67 22 0a 09 7d 0a 09 69 66 20 7b 5b 63 61 msg"..}..if {[ca
1a40: 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 tch {puts $comma
1a50: 6e 64 53 6f 63 6b 65 74 20 22 2d 2d 4d 61 72 6b ndSocket "--Mark
1a60: 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b er--Marker--Mark
1a70: 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 7b 0a 09 er--"} msg]} {..
1a80: 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 error "remot
1a90: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 e server disappe
1aa0: 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 0a ared: $msg"..}..
1ab0: 09 73 65 74 20 72 65 73 70 20 22 22 0a 09 77 68 .set resp ""..wh
1ac0: 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 20 20 73 ile {1} {.. s
1ad0: 65 74 20 6c 69 6e 65 20 5b 67 65 74 73 20 24 63 et line [gets $c
1ae0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 0a 09 20 ommandSocket]..
1af0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d if {[eof $com
1b00: 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 mandSocket]} {..
1b10: 09 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 .error "remote s
1b20: 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 65 erver disappeare
1b30: 64 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 d".. }.. i
1b40: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
1b50: 72 65 20 24 6c 69 6e 65 20 22 2d 2d 4d 61 72 6b re $line "--Mark
1b60: 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b er--Marker--Mark
1b70: 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 7b 0a 09 er--"] == 0} {..
1b80: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d .if {[string com
1b90: 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 72 65 pare [lindex $re
1ba0: 73 70 20 30 5d 20 65 72 72 6f 72 5d 20 3d 3d 20 sp 0] error] ==
1bb0: 30 7d 20 7b 0a 09 09 20 20 20 20 65 72 72 6f 72 0} {... error
1bc0: 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 [lindex $resp 1
1bd0: 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 ]...} else {...
1be0: 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 6e 64 65 return [linde
1bf0: 78 20 24 72 65 73 70 20 31 5d 0a 09 09 7d 0a 09 x $resp 1]...}..
1c00: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 61 } else {...a
1c10: 70 70 65 6e 64 20 72 65 73 70 20 24 6c 69 6e 65 ppend resp $line
1c20: 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a 09 7d 0a "\n".. }..}.
1c30: 20 20 20 20 7d 0a 7d 0a 0a 74 65 73 74 20 73 6f }.}..test so
1c40: 63 6b 65 74 2d 31 2e 31 20 7b 61 72 67 20 70 61 cket-1.1 {arg pa
1c50: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
1c60: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
1c70: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
1c80: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
1c90: 74 20 2d 73 65 72 76 65 72 7d 20 6d 73 67 5d 20 t -server} msg]
1ca0: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
1cb0: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
1cc0: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
1cd0: 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 -server command
1ce0: 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d ?options? port"}
1cf0: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 }..test socket-1
1d00: 2e 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .2 {arg parsing
1d10: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1d20: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1d30: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1d40: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
1d50: 76 65 72 20 66 6f 6f 7d 20 6d 73 67 5d 20 24 6d ver foo} msg] $m
1d60: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
1d70: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
1d80: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 "tls::socket -s
1d90: 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f erver command ?o
1da0: 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a ptions? port"}}.
1db0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 33 .test socket-1.3
1dc0: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
1dd0: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
1de0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
1df0: 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c list [catch {tl
1e00: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 s::socket -myadd
1e10: 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b r} msg] $msg.} {
1e20: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
1e30: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
1e40: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
1e50: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
1e60: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 34 20 test socket-1.4
1e70: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
1e80: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
1e90: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
1ea0: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
1eb0: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 ::socket -myaddr
1ec0: 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 5d 127.0.0.1} msg]
1ed0: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
1ee0: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
1ef0: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
1f00: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
1f10: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f port"}}..test so
1f20: 63 6b 65 74 2d 31 2e 35 20 7b 61 72 67 20 70 61 cket-1.5 {arg pa
1f30: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
1f40: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
1f50: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
1f60: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
1f70: 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d 20 t -myport} msg]
1f80: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
1f90: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
1fa0: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
1fb0: 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 ?options? host p
1fc0: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 ort"}}..test soc
1fd0: 6b 65 74 2d 31 2e 36 20 7b 61 72 67 20 70 61 72 ket-1.6 {arg par
1fe0: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
1ff0: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2000: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2010: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2020: 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 6d -myport xxxx} m
2030: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2040: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2050: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2060: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
2070: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
2080: 20 73 6f 63 6b 65 74 2d 31 2e 37 20 7b 61 72 67 socket-1.7 {arg
2090: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
20a0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
20b0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
20c0: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
20d0: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 cket -myport 252
20e0: 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 2} msg] $msg.} {
20f0: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2100: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2110: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
2120: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
2130: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 38 20 test socket-1.8
2140: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2150: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2160: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2170: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2180: 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a ::socket -froboz
2190: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
21a0: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
21b0: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
21c0: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
21d0: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
21e0: 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 39 20 7b est socket-1.9 {
21f0: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2200: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2210: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2220: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2230: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
2240: 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 32 35 32 31 foo -myport 2521
2250: 20 33 33 33 33 7d 20 6d 73 67 5d 20 24 6d 73 67 3333} msg] $msg
2260: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
2270: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
2280: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
2290: 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 ver command ?opt
22a0: 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 ions? port"}}..t
22b0: 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 31 30 20 est socket-1.10
22c0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
22d0: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
22e0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
22f0: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2300: 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 74 20 32 35 ::socket host 25
2310: 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 28 -junk} msg] $
2320: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2330: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2340: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2350: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2360: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b rt"}}..test sock
2370: 65 74 2d 31 2e 31 31 20 7b 61 72 67 20 70 61 72 et-1.11 {arg par
2380: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2390: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
23a0: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
23b0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
23c0: 20 2d 73 65 72 76 65 72 20 63 61 6c 6c 62 61 63 -server callbac
23d0: 6b 20 32 35 32 30 20 2d 2d 7d 20 6d 73 67 5d 20 k 2520 --} msg]
23e0: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
23f0: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
2400: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
2410: 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 -server command
2420: 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d ?options? port"}
2430: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 }..test socket-1
2440: 2e 31 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 .12 {arg parsing
2450: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2460: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2470: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2480: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f {tls::socket foo
2490: 20 62 61 64 70 6f 72 74 7d 20 6d 73 67 5d 20 24 badport} msg] $
24a0: 6d 73 67 0a 7d 20 7b 31 20 7b 65 78 70 65 63 74 msg.} {1 {expect
24b0: 65 64 20 69 6e 74 65 67 65 72 20 62 75 74 20 67 ed integer but g
24c0: 6f 74 20 22 62 61 64 70 6f 72 74 22 7d 7d 0a 0a ot "badport"}}..
24d0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 31 20 test socket-2.1
24e0: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d {tcp connection}
24f0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
2500: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
2510: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
2520: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
2530: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
2540: 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 .package req
2550: 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 uire tls..set ti
2560: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 mer [after 2000
2570: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
2580: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
2590: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
25a0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
25b0: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
25c0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
25d0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
25e0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
25f0: 65 79 20 32 38 32 38 20 5c 5d 22 0a 20 20 20 20 ey 2828 \]".
2600: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
2610: 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 accept {file add
2620: 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 r port} {.. g
2630: 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 lobal x.. set
2640: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
2650: 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a close $file.
2660: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
2670: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
2680: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
2690: 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a ose $f..puts $x.
26a0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
26b0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
26c0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
26d0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
26e0: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
26f0: 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 ets $f x. if
2700: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
2710: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
2720: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
2730: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
2740: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
2750: 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 y 127.0.0.1 2828
2760: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
2770: 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 set x $msg.
2780: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
2790: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
27a0: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
27b0: 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ose $msg. }.
27c0: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
27d0: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
27e0: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
27f0: 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a {ready done {}}.
2800: 0a 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 73 .if [info exists
2810: 20 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e 63 port] {. inc
2820: 72 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b 20 r port.} else {
2830: 0a 20 20 20 20 73 65 74 20 70 6f 72 74 20 5b 65 . set port [e
2840: 78 70 72 20 32 30 34 38 20 2b 20 5b 70 69 64 5d xpr 2048 + [pid]
2850: 25 31 30 32 34 5d 0a 7d 0a 0a 74 65 73 74 20 73 %1024].}..test s
2860: 6f 63 6b 65 74 2d 32 2e 32 20 7b 74 63 70 20 63 ocket-2.2 {tcp c
2870: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 onnection with c
2880: 6c 69 65 6e 74 20 70 6f 72 74 20 73 70 65 63 69 lient port speci
2890: 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 fied} {socket st
28a0: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
28b0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
28c0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
28d0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
28e0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
28f0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
2900: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
2910: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 "set x done"].
2920: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
2930: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
2940: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
2950: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
2960: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
2970: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
2980: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 ile $serverKey 2
2990: 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 829 \]". puts
29a0: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
29b0: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
29c0: 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 rt} {.
29d0: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
29e0: 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 puts "[ge
29f0: 74 73 20 24 66 69 6c 65 5d 20 24 70 6f 72 74 22 ts $file] $port"
2a00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
2a10: 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 se $file.
2a20: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
2a30: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
2a40: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
2a50: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
2a60: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
2a70: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2a80: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
2a90: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
2aa0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
2ab0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
2ac0: 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f 72 74 0a global port.
2ad0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
2ae0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 tls::socket -myp
2af0: 6f 72 74 20 24 70 6f 72 74 20 5c 0a 09 2d 63 65 ort $port \..-ce
2b00: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
2b10: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2b20: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
2b30: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
2b40: 30 2e 31 20 32 38 32 39 7d 20 73 6f 63 6b 5d 7d 0.1 2829} sock]}
2b50: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
2b60: 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 20 7b 63 $sock..catch {c
2b70: 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 lose [tls::socke
2b80: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 t 127.0.0.1 2829
2b90: 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ]}. } else {.
2ba0: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 6f puts $so
2bb0: 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 ck hello..flush
2bc0: 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 $sock. la
2bd0: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
2be0: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
2bf0: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
2c00: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2c10: 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 61 64 79 x.} [list ready
2c20: 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 22 5d 0a "hello $port"].
2c30: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 33 .test socket-2.3
2c40: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
2c50: 20 77 69 74 68 20 63 6c 69 65 6e 74 20 69 6e 74 with client int
2c60: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
2c70: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
2c80: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
2c90: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
2ca0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
2cb0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
2cc0: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
2cd0: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
2ce0: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
2cf0: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
2d00: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
2d10: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
2d20: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
2d30: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
2d40: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
2d50: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
2d60: 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 30 20 $serverKey 2830
2d70: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
2d80: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
2d90: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
2da0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
2db0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
2dc0: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
2dd0: 66 69 6c 65 5d 20 24 61 64 64 72 22 0a 20 20 20 file] $addr".
2de0: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
2df0: 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 file.
2e00: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
2e10: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
2e20: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
2e30: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
2e40: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
2e50: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
2e60: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
2e70: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
2e80: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
2e90: 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 gets $f x.
2ea0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
2eb0: 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 :socket -myaddr
2ec0: 31 32 37 2e 30 2e 30 2e 31 20 5c 0a 09 2d 63 65 127.0.0.1 \..-ce
2ed0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
2ee0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2ef0: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
2f00: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
2f10: 30 2e 31 20 32 38 33 30 7d 20 73 6f 63 6b 5d 7d 0.1 2830} sock]}
2f20: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
2f30: 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 $sock. } els
2f40: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
2f50: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 63 61 $sock hello..ca
2f60: 74 63 68 20 7b 66 6c 75 73 68 20 24 73 6f 63 6b tch {flush $sock
2f70: 7d 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e }. lappen
2f80: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
2f90: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 close $soc
2fa0: 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 k. }. clos
2fb0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
2fc0: 20 7b 72 65 61 64 79 20 7b 68 65 6c 6c 6f 20 31 {ready {hello 1
2fd0: 32 37 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 73 74 27.0.0.1}}..test
2fe0: 20 73 6f 63 6b 65 74 2d 32 2e 34 20 7b 74 63 70 socket-2.4 {tcp
2ff0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 connection with
3000: 20 73 65 72 76 65 72 20 69 6e 74 65 72 66 61 63 server interfac
3010: 65 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f e specified} {so
3020: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
3030: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
3040: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
3050: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
3060: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
3070: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
3080: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
3090: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 er 2000 "set x d
30a0: 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 one"]. }.
30b0: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
30c0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
30d0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
30e0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
30f0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3100: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
3110: 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 5b 69 erKey -myaddr [i
3120: 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 nfo hostname] 28
3130: 33 31 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 31 \]". puts
3140: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
3150: 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 t {file addr por
3160: 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 t} {.
3170: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
3180: 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 puts "[get
3190: 73 20 24 66 69 6c 65 5d 22 0a 20 20 20 20 20 20 s $file]".
31a0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c close $fil
31b0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 e. se
31c0: 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 t x done..}..put
31d0: 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 s ready..vwait x
31e0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
31f0: 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a timer..close $f.
3200: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
3210: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
3220: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
3230: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
3240: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
3250: 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 ets $f x. if
3260: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f {[catch {tls::so
3270: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
3280: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
3290: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
32a0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
32b0: 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 y [info hostname
32c0: 5d 20 32 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 7b ] 2831} sock]} {
32d0: 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 . set x $
32e0: 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 sock. } else
32f0: 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 24 {. puts $
3300: 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 sock hello..flus
3310: 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 h $sock.
3320: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
3330: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
3340: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
3350: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3360: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 65 et x.} {ready he
3370: 6c 6c 6f 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 llo}..test socke
3380: 74 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 t-2.5 {tcp conne
3390: 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e ction with redun
33a0: 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 dant server port
33b0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
33c0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
33d0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
33e0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
33f0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
3400: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
3410: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
3420: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
3430: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
3440: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3450: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3460: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3470: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
3480: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
3490: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
34a0: 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 32 20 $serverKey 2832
34b0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
34c0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
34d0: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
34e0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
34f0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
3500: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
3510: 66 69 6c 65 5d 22 0a 20 20 20 20 20 20 20 20 20 file]".
3520: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 close $file.
3530: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
3540: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
3550: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
3560: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
3570: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 er..close $f.
3580: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3590: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
35a0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
35b0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
35c0: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
35d0: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
35e0: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
35f0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
3600: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
3610: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
3620: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
3630: 32 37 2e 30 2e 30 2e 31 20 32 38 33 32 7d 20 73 27.0.0.1 2832} s
3640: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
3650: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
3660: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
3670: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
3680: 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 o..flush $sock.
3690: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
36a0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
36b0: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
36c0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
36d0: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 f. set x.} {r
36e0: 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 eady hello}.test
36f0: 20 73 6f 63 6b 65 74 2d 32 2e 36 20 7b 74 63 70 socket-2.6 {tcp
3700: 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f connection} {so
3710: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
3720: 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 status ok. if
3730: 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 {![catch {set s
3740: 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ock [tls::socket
3750: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 33 5d 127.0.0.1 2833]
3760: 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 }]} {..if {![cat
3770: 63 68 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d ch {gets $sock}]
3780: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 } {.. set sta
3790: 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 tus broken..}..c
37a0: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
37b0: 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a . set status.
37c0: 7d 20 6f 6b 0a 0a 74 65 73 74 20 73 6f 63 6b 65 } ok..test socke
37d0: 74 2d 32 2e 37 20 7b 65 63 68 6f 20 73 65 72 76 t-2.7 {echo serv
37e0: 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 er, one line} {s
37f0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
3800: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
3810: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
3820: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
3830: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
3840: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3850: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
3860: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
3870: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
3880: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3890: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
38a0: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
38b0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
38c0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
38d0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
38e0: 76 65 72 4b 65 79 20 32 38 33 34 20 5c 5d 22 0a verKey 2834 \]".
38f0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3900: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
3910: 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 p} {.
3920: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
3930: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
3940: 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 o $s].. fconf
3950: 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c igure $s -transl
3960: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
3970: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 ing line.
3980: 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 }..proc echo {s
3990: 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 20 6c 20 } {.. set l
39a0: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
39b0: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
39c0: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
39d0: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
39e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
39f0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
3a00: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
3a10: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
3a20: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
3a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
3a40: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
3a50: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 }..}..puts
3a60: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
3a70: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
3a80: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 imer..close $f..
3a90: 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 20 7d 0a puts done. }.
3aa0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3ab0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
3ac0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
3ad0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
3ae0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
3af0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
3b00: 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c :socket -certfil
3b10: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3b20: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3b30: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
3b40: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 tKey 127.0.0.1 2
3b50: 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 834]. fconfig
3b60: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
3b70: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
3b80: 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 74 73 20 ion lf. puts
3b90: 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 $s "hello abcdef
3ba0: 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 ghijklmnop".
3bb0: 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 after 1000. s
3bc0: 65 74 20 78 20 5b 67 65 74 73 20 24 73 5d 0a 20 et x [gets $s].
3bd0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
3be0: 73 65 74 20 79 20 5b 67 65 74 73 20 24 66 5d 0a set y [gets $f].
3bf0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
3c00: 20 6c 69 73 74 20 24 78 20 24 79 0a 7d 20 7b 7b list $x $y.} {{
3c10: 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a hello abcdefghij
3c20: 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 klmnop} done}..t
3c30: 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 38 20 7b est socket-2.8 {
3c40: 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f echo server, loo
3c50: 70 20 35 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 p 50 times, sing
3c60: 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b le connection} {
3c70: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
3c80: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3c90: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
3ca0: 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 ts $f {. .pac
3cb0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
3cc0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
3cd0: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
3ce0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
3cf0: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
3d00: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
3d10: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
3d20: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
3d30: 20 32 38 33 35 20 5c 5d 22 0a 20 20 20 20 70 75 2835 \]". pu
3d40: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
3d50: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 cept {s a p} {.
3d60: 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 filee
3d70: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
3d80: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
3d90: 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e fcon
3da0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
3db0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 ring line.
3dc0: 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b }..proc echo {
3dd0: 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 s} {.. globa
3de0: 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 l i.
3df0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
3e00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 . if
3e10: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
3e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 g
3e30: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
3e40: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
3e50: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
3e60: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
3e70: 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 } els
3e80: 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 e { .. i
3e90: 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 ncr i.
3ea0: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 puts $s $
3eb0: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d l. }
3ec0: 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 75 ..}..set i 0..pu
3ed0: 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 ts ready..set ti
3ee0: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 mer [after 20000
3ef0: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 "set x done"]..
3f00: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
3f10: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
3f20: 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 64 6f ose $f..puts "do
3f30: 6e 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 20 ne $i". }.
3f40: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
3f50: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
3f60: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
3f70: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
3f80: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
3f90: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
3fa0: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
3fb0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
3fc0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
3fd0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
3fe0: 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 35 y 127.0.0.1 2835
3ff0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4000: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
4010: 69 6e 65 0a 20 20 20 20 63 61 74 63 68 20 7b 0a ine. catch {.
4020: 09 66 6f 72 20 7b 73 65 74 20 78 20 30 7d 20 7b .for {set x 0} {
4030: 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 78 $x < 50} {incr x
4040: 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 } {.. puts $s
4050: 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 "hello abcdefgh
4060: 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 67 ijklmnop".. g
4070: 65 74 73 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ets $s..}. }.
4080: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
4090: 20 63 61 74 63 68 20 7b 73 65 74 20 78 20 5b 67 catch {set x [g
40a0: 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 6c 6f ets $f]}. clo
40b0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
40c0: 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 } {done 50}..tes
40d0: 74 20 73 6f 63 6b 65 74 2d 32 2e 39 20 7b 73 6f t socket-2.9 {so
40e0: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b cket conflict} {
40f0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
4100: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
4110: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4120: 63 63 65 70 74 20 32 38 32 38 5d 0a 20 20 20 20 ccept 2828].
4130: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
4140: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
4150: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
4160: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
4170: 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 71 75 $f {package requ
4180: 69 72 65 20 74 6c 73 3b 20 74 6c 73 3a 3a 73 6f ire tls; tls::so
4190: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
41a0: 65 70 74 20 32 38 32 38 7d 0a 20 20 20 20 63 6c ept 2828}. cl
41b0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
41c0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
41d0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
41e0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
41f0: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 61 gets $f. a
4200: 66 74 65 72 20 31 30 30 0a 20 20 20 20 73 65 74 fter 100. set
4210: 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 x [list [catch
4220: 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d 20 {close $f} msg]
4230: 24 6d 73 67 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $msg]. close
4240: 24 73 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $s. set x.} {
4250: 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 1 {couldn't open
4260: 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 socket: address
4270: 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 0a already in use.
4280: 20 20 20 20 77 68 69 6c 65 20 65 78 65 63 75 74 while execut
4290: 69 6e 67 0a 22 3a 3a 73 6f 63 6b 65 74 20 2d 73 ing."::socket -s
42a0: 65 72 76 65 72 20 7b 74 6c 73 3a 3a 5f 61 63 63 erver {tls::_acc
42b0: 65 70 74 20 7b 2d 73 65 72 76 65 72 20 31 7d 20 ept {-server 1}
42c0: 61 63 63 65 70 74 7d 20 32 38 32 38 22 0a 20 20 accept} 2828".
42d0: 20 20 28 22 65 76 61 6c 22 20 62 6f 64 79 20 6c ("eval" body l
42e0: 69 6e 65 20 31 29 0a 20 20 20 20 69 6e 76 6f 6b ine 1). invok
42f0: 65 64 20 66 72 6f 6d 20 77 69 74 68 69 6e 0a 22 ed from within."
4300: 65 76 61 6c 20 3a 3a 73 6f 63 6b 65 74 20 24 73 eval ::socket $s
4310: 6f 70 74 73 22 0a 20 20 20 20 28 70 72 6f 63 65 opts". (proce
4320: 64 75 72 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 dure "tls::socke
4330: 74 22 20 6c 69 6e 65 20 36 32 29 0a 20 20 20 20 t" line 62).
4340: 69 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 invoked from wit
4350: 68 69 6e 0a 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 hin."tls::socket
4360: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4370: 32 38 32 38 22 0a 20 20 20 20 28 66 69 6c 65 20 2828". (file
4380: 22 73 63 72 69 70 74 22 20 6c 69 6e 65 20 31 29 "script" line 1)
4390: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
43a0: 32 2e 31 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 2.10 {close on a
43b0: 63 63 65 70 74 2c 20 61 63 63 65 70 74 65 64 20 ccept, accepted
43c0: 73 6f 63 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73 socket lives} {s
43d0: 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 7d 20 ocket knownBug}
43e0: 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 {. set done 0
43f0: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
4400: 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 after 20000 "set
4410: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
4420: 5d 0a 20 20 20 20 73 65 74 20 73 73 20 5b 74 6c ]. set ss [tl
4430: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4440: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
4450: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
4460: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4470: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 ..-keyfile $serv
4480: 65 72 4b 65 79 20 32 38 33 30 5d 0a 20 20 20 20 erKey 2830].
4490: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
44a0: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 p} {..global ss
44b0: 0a 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c ..close $ss..fil
44c0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
44d0: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 09 le "readit $s"..
44e0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
44f0: 72 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 rans lf. }.
4500: 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 proc readit {s
4510: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 } {..global done
4520: 0a 09 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 ..gets $s..close
4530: 20 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a $s..set done 1.
4540: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 73 }. set cs
4550: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
4560: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
4570: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4580: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4590: 24 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f $clientKey [info
45a0: 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d hostname] 2830]
45b0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a 0a . close $cs..
45c0: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
45d0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
45e0: 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 20 64 $timer. set d
45f0: 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 73 6f one.} 1..test so
4600: 63 6b 65 74 2d 32 2e 31 31 20 7b 64 65 74 65 63 cket-2.11 {detec
4610: 74 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 7b ting new data} {
4620: 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 7d socket knownBug}
4630: 20 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 {. proc acce
4640: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
4650: 6f 62 61 6c 20 73 6f 63 6b 0a 09 73 65 74 20 73 obal sock..set s
4660: 6f 63 6b 20 24 73 0a 09 73 65 74 20 66 20 5b 6f ock $s..set f [o
4670: 70 65 6e 20 61 77 62 2e 6c 6f 67 20 77 5d 0a 09 pen awb.log w]..
4680: 70 75 74 73 20 24 66 20 5b 63 61 74 63 68 20 7b puts $f [catch {
4690: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
46a0: 73 6f 63 6b 7d 20 65 72 72 5d 0a 09 70 75 74 73 sock} err]..puts
46b0: 20 24 66 20 22 65 72 72 3a 20 24 65 72 72 22 0a $f "err: $err".
46c0: 09 70 75 74 73 20 24 66 20 22 5b 74 6c 73 3a 3a .puts $f "[tls::
46d0: 73 74 61 74 75 73 20 24 73 6f 63 6b 5d 22 0a 09 status $sock]"..
46e0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 0a close $s. }..
46f0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
4700: 73 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 socket -require
4710: 30 20 2d 72 65 71 75 65 73 74 20 30 20 2d 73 65 0 -request 0 -se
4720: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
4730: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
4740: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
4750: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 t \..-keyfile $s
4760: 65 72 76 65 72 4b 65 79 20 32 34 30 30 5d 0a 20 erverKey 2400].
4770: 20 20 20 73 65 74 20 73 6f 63 6b 20 22 22 0a 20 set sock "".
4780: 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a set s2 [tls::
4790: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
47a0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
47b0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
47c0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
47d0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 34 Key 127.0.0.1 24
47e0: 30 30 5d 0a 20 20 20 20 76 77 61 69 74 20 73 6f 00]. vwait so
47f0: 63 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 ck. puts $s2
4800: 6f 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 one. flush $s
4810: 32 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0a 2. after 500.
4820: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
4830: 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 sock -blocking 0
4840: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 20 . set result
4850: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
4860: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
4870: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
4880: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
4890: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 k -blocking 1.
48a0: 20 20 70 75 74 73 20 24 73 32 20 74 77 6f 0a 20 puts $s2 two.
48b0: 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 flush $s2.
48c0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
48d0: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 k -blocking 0.
48e0: 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 lappend result
48f0: 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 [gets $sock].
4900: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
4910: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 ck -blocking 1.
4920: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
4930: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c close $s. cl
4940: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 ose $sock. se
4950: 74 20 72 65 73 75 6c 74 0a 7d 20 7b 6f 6e 65 20 t result.} {one
4960: 7b 7d 20 74 77 6f 7d 0a 0a 74 65 73 74 20 73 6f {} two}..test so
4970: 63 6b 65 74 2d 32 2e 31 32 20 7b 74 63 70 20 63 cket-2.12 {tcp c
4980: 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 onnection; no ce
4990: 72 74 69 66 69 63 61 74 65 73 20 73 70 65 63 69 rtificates speci
49a0: 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 fied} {socket st
49b0: 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 dio pcCrash} {.
49c0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
49d0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
49e0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
49f0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
4a00: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
4a10: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
4a20: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
4a30: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
4a40: 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 .set f [tls::soc
4a50: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
4a60: 70 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 pt 2828]..proc a
4a70: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
4a80: 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c port} {.. gl
4a90: 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 obal x.. set
4aa0: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
4ab0: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 close $file..
4ac0: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
4ad0: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
4ae0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
4af0: 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 se $f..puts $x.
4b00: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
4b10: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
4b20: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
4b30: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
4b40: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
4b50: 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b ts $f x. if {
4b60: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
4b70: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
4b80: 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 28} msg]} {.
4b90: 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 set x $msg.
4ba0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
4bb0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
4bc0: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
4bd0: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
4be0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b . lappend x [
4bf0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
4c00: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
4c10: 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d } {ready done {}
4c20: 7d 0a 0a 0a 0a 0a 74 65 73 74 20 73 6f 63 6b 65 }.....test socke
4c30: 74 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 63 6f t-3.1 {socket co
4c40: 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 nflict} {socket
4c50: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
4c60: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
4c70: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
4c80: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
4c90: 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b s $f {. .pack
4ca0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
4cb0: 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 .set f [tls::soc
4cc0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
4cd0: 70 74 20 32 38 32 38 5d 0a 09 70 75 74 73 20 72 pt 2828]..puts r
4ce0: 65 61 64 79 0a 09 67 65 74 73 20 73 74 64 69 6e eady..gets stdin
4cf0: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
4d00: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
4d10: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
4d20: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
4d30: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
4d40: 5d 22 20 72 2b 5d 0a 20 20 20 20 67 65 74 73 20 ]" r+]. gets
4d50: 24 66 0a 20 20 20 20 73 65 74 20 78 20 5b 6c 69 $f. set x [li
4d60: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
4d70: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4d80: 63 63 65 70 74 20 32 38 32 38 7d 20 6d 73 67 5d ccept 2828} msg]
4d90: 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 \...$msg]. p
4da0: 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 20 63 uts $f bye. c
4db0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4dc0: 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 x.} {1 {couldn't
4dd0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
4de0: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
4df0: 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 use}}..test soc
4e00: 6b 65 74 2d 33 2e 32 20 7b 73 65 72 76 65 72 20 ket-3.2 {server
4e10: 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 with several cli
4e20: 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 ents} {socket st
4e30: 64 69 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 dio pcCrash} {.
4e40: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
4e50: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
4e60: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
4e70: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
4e80: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
4e90: 65 20 74 6c 73 0a 09 73 65 74 20 74 31 20 5b 61 e tls..set t1 [a
4ea0: 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74 20 fter 30000 "set
4eb0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
4ec0: 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 et t2 [after 310
4ed0: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
4ee0: 6f 75 74 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 out"]..set t3 [a
4ef0: 66 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 fter 32000 "set
4f00: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
4f10: 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 09 73 65 et counter 0..se
4f20: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
4f30: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4f40: 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 2828]..proc acce
4f50: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
4f60: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
4f70: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
4f80: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
4f90: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
4fa0: 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 ring line..}..pr
4fb0: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
4fc0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
4fd0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 set l
4fe0: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
4ff0: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
5000: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
5010: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
5020: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5030: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
5040: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
5050: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
5060: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
5070: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
5080: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
5090: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
50a0: 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 20 78 cel $t1..vwait x
50b0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
50c0: 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 t2..vwait x..aft
50d0: 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 er cancel $t3..c
50e0: 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 24 78 lose $s..puts $x
50f0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
5100: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
5110: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
5120: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
5130: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
5140: 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d set x [gets $f]
5150: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
5160: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
5170: 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 2828]. fco
5180: 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 nfigure $s1 -buf
5190: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
51a0: 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 set s2 [tls::soc
51b0: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
51c0: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
51d0: 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e re $s2 -bufferin
51e0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
51f0: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 3 [tls::socket 1
5200: 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 27.0.0.1 2828].
5210: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
5220: 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 3 -buffering lin
5230: 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 e. for {set i
5240: 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 0} {$i < 100} {
5250: 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 incr i} {..puts
5260: 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 $s1 hello,s1..ge
5270: 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 ts $s1..puts $s2
5280: 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 hello,s2..gets
5290: 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 $s2..puts $s3 he
52a0: 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 73 33 llo,s3..gets $s3
52b0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
52c0: 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s1. close $
52d0: 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 s2. close $s3
52e0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b . lappend x [
52f0: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f gets $f]. clo
5300: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
5310: 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a } {ready done}..
5320: 74 65 73 74 20 73 6f 63 6b 65 74 2d 34 2e 31 20 test socket-4.1
5330: 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 76 {server with sev
5340: 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 eral clients} {s
5350: 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 ocket stdio pcCr
5360: 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ash} {. remov
5370: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
5380: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
5390: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
53a0: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
53b0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 e require tls..g
53c0: 65 74 73 20 73 74 64 69 6e 0a 09 73 65 74 20 73 ets stdin..set s
53d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 [tls::socket 12
53e0: 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 09 66 7.0.0.1 2828]..f
53f0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
5400: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f ffering line..fo
5410: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
5420: 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 < 100} {incr i}
5430: 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 68 {.. puts $s h
5440: 65 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 ello.. gets $
5450: 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 s..}..close $s..
5460: 70 75 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 puts bye..gets s
5470: 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 tdin. }. c
5480: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
5490: 70 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 p1 [open "|[list
54a0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
54b0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b test script]" r+
54c0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
54d0: 20 24 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 $p1 -buffering
54e0: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 line. set p2
54f0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
5500: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
5510: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
5520: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 fconfigure $p
5530: 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 2 -buffering lin
5540: 65 0a 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 e. set p3 [op
5550: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
5560: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
5570: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
5580: 66 63 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d fconfigure $p3 -
5590: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
55a0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
55b0: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
55c0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
55d0: 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 ng line..fileeve
55e0: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
55f0: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 list echo $s].
5600: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 }. proc ech
5610: 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 o {s} {..global
5620: 78 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 x. set l
5630: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
5640: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
5650: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c {. cl
5660: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
5670: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
5680: 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 } else {.
5690: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
56a0: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a $s $l. }.
56b0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 }. set t1
56c0: 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 [after 30000 "s
56d0: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
56e0: 0a 20 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 . set t2 [aft
56f0: 65 72 20 33 31 30 30 30 20 22 73 65 74 20 78 20 er 31000 "set x
5700: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
5710: 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 set t3 [after 32
5720: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
5730: 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 _out"]. set s
5740: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
5750: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
5760: 38 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 8]. puts $p1
5770: 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 24 70 open. puts $p
5780: 32 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 2 open. puts
5790: 24 70 33 20 6f 70 65 6e 0a 20 20 20 20 76 77 61 $p3 open. vwa
57a0: 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 it x. vwait x
57b0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
57c0: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
57d0: 31 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 1. after canc
57e0: 65 6c 20 24 74 32 0a 20 20 20 20 61 66 74 65 72 el $t2. after
57f0: 20 63 61 6e 63 65 6c 20 24 74 33 0a 20 20 20 20 cancel $t3.
5800: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 close $s. set
5810: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
5820: 64 20 6c 20 5b 6c 69 73 74 20 70 31 20 5b 67 65 d l [list p1 [ge
5830: 74 73 20 24 70 31 5d 20 24 78 5d 0a 20 20 20 20 ts $p1] $x].
5840: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 lappend l [list
5850: 70 32 20 5b 67 65 74 73 20 24 70 32 5d 20 24 78 p2 [gets $p2] $x
5860: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
5870: 5b 6c 69 73 74 20 70 33 20 5b 67 65 74 73 20 24 [list p3 [gets $
5880: 70 33 5d 20 24 78 5d 0a 20 20 20 20 70 75 74 73 p3] $x]. puts
5890: 20 24 70 31 20 62 79 65 0a 20 20 20 20 70 75 74 $p1 bye. put
58a0: 73 20 24 70 32 20 62 79 65 0a 20 20 20 20 70 75 s $p2 bye. pu
58b0: 74 73 20 24 70 33 20 62 79 65 0a 20 20 20 20 63 ts $p3 bye. c
58c0: 6c 6f 73 65 20 24 70 31 0a 20 20 20 20 63 6c 6f lose $p1. clo
58d0: 73 65 20 24 70 32 0a 20 20 20 20 63 6c 6f 73 65 se $p2. close
58e0: 20 24 70 33 0a 20 20 20 20 73 65 74 20 6c 0a 7d $p3. set l.}
58f0: 20 7b 7b 70 31 20 62 79 65 20 64 6f 6e 65 7d 20 {{p1 bye done}
5900: 7b 70 32 20 62 79 65 20 64 6f 6e 65 7d 20 7b 70 {p2 bye done} {p
5910: 33 20 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a 74 65 3 bye done}}..te
5920: 73 74 20 73 6f 63 6b 65 74 2d 34 2e 32 20 7b 62 st socket-4.2 {b
5930: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
5940: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
5950: 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 6b rs, htons} {sock
5960: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 et} {. set x
5970: 6f 6b 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 ok. if {[catc
5980: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
5990: 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 33 30 server dodo 0x30
59a0: 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 00} msg]} {..set
59b0: 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c x $msg. } el
59c0: 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 se {..close $msg
59d0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
59e0: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 73 6f 63 6b .} ok..test sock
59f0: 65 74 2d 35 2e 31 20 7b 62 79 74 65 20 6f 72 64 et-5.1 {byte ord
5a00: 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 er problems, soc
5a10: 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f ket numbers, hto
5a20: 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 ns} \..{socket u
5a30: 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d nixOnly notRoot}
5a40: 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f {. set x {co
5a50: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
5a60: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 et: not owner}.
5a70: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
5a80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
5a90: 76 65 72 20 64 6f 64 6f 20 30 78 31 7d 20 6d 73 ver dodo 0x1} ms
5aa0: 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 g]} {. se
5ab0: 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c t x {htons probl
5ac0: 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 em, should be di
5ad0: 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f sallowed, are yo
5ae0: 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f u running as SU?
5af0: 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 }..close $msg.
5b00: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
5b10: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
5b20: 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 ocket: not owner
5b30: 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 35 2e }.test socket-5.
5b40: 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 2 {byte order pr
5b50: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
5b60: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b umbers, htons} {
5b70: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
5b80: 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 t x {couldn't op
5b90: 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 en socket: port
5ba0: 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d number too high}
5bb0: 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 . if {![catch
5bc0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 {tls::socket -s
5bd0: 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 30 30 erver dodo 0x100
5be0: 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 00} msg]} {..set
5bf0: 20 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c 75 74 x {port resolut
5c00: 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f ion problem, sho
5c10: 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 uld be disallowe
5c20: 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 d}..close $msg.
5c30: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
5c40: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
5c50: 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d socket: port num
5c60: 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 74 65 ber too high}.te
5c70: 73 74 20 73 6f 63 6b 65 74 2d 35 2e 33 20 7b 62 st socket-5.3 {b
5c80: 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 yte order proble
5c90: 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 ms, socket numbe
5ca0: 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 rs, htons} \..{s
5cb0: 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e ocket unixOnly n
5cc0: 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 otRoot} {. se
5cd0: 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 t x {couldn't op
5ce0: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
5cf0: 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b wner}. if {![
5d00: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
5d10: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
5d20: 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 21} msg]} {..set
5d30: 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 x {htons proble
5d40: 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 m, should be dis
5d50: 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 allowed, are you
5d60: 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d running as SU?}
5d70: 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 ..close $msg.
5d80: 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b }. set x.} {
5d90: 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f couldn't open so
5da0: 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d cket: not owner}
5db0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 36 2e ..test socket-6.
5dc0: 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 1 {accept callba
5dd0: 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 ck error} {socke
5de0: 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d t stdio pcCrash}
5df0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
5e00: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
5e10: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
5e20: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
5e30: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
5e40: 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 quire tls..gets
5e50: 73 74 64 69 6e 0a 09 74 6c 73 3a 3a 73 6f 63 6b stdin..tls::sock
5e60: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 34 et 127.0.0.1 284
5e70: 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 8. }. clos
5e80: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
5e90: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
5ea0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
5eb0: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
5ec0: 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 proc bgerror a
5ed0: 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a rgs {..global x.
5ee0: 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 .set x $args.
5ef0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 }. proc acce
5f00: 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 pt {s a p} {expr
5f10: 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 73 65 74 10 / 0}. set
5f20: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
5f30: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
5f40: 38 34 38 5d 0a 20 20 20 20 70 75 74 73 20 24 66 848]. puts $f
5f50: 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c 6f 73 65 hello. close
5f60: 20 24 66 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $f. set time
5f70: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
5f80: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
5f90: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
5fa0: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
5fb0: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
5fc0: 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 20 62 67 $s. rename bg
5fd0: 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 73 65 74 error {}. set
5fe0: 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 20 62 79 x.} {{divide by
5ff0: 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 20 73 6f zero}}..test so
6000: 63 6b 65 74 2d 37 2e 31 20 7b 74 65 73 74 69 6e cket-7.1 {testin
6010: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
6020: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b c options} {sock
6030: 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 et stdio pcCrash
6040: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
6050: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
6060: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
6070: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
6080: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
6090: 72 65 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 6f 63 re tls..tls::soc
60a0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
60b0: 70 74 20 32 38 32 30 0a 09 70 72 6f 63 20 61 63 pt 2820..proc ac
60c0: 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 cept args {..
60d0: 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 global x.. s
60e0: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
60f0: 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 ts ready..set ti
6100: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
6110: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
6120: 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 t"]..vwait x..af
6130: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
6140: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
6150: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
6160: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
6170: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
6180: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
6190: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
61a0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
61b0: 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 30 5d 0a 127.0.0.1 2820].
61c0: 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 set p [fconf
61d0: 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 igure $s -peerna
61e0: 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 me]. close $s
61f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
6200: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
6210: 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 append l [string
6220: 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 compare [lindex
6230: 20 24 70 20 30 5d 20 31 32 37 2e 30 2e 30 2e 31 $p 0] 127.0.0.1
6240: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
6250: 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 [string compare
6260: 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 32 38 [lindex $p 2] 28
6270: 32 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 20]. lappend
6280: 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 7d l [llength $p].}
6290: 20 7b 30 20 30 20 33 7d 0a 74 65 73 74 20 73 6f {0 0 3}.test so
62a0: 63 6b 65 74 2d 37 2e 32 20 7b 74 65 73 74 69 6e cket-7.2 {testin
62b0: 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 g socket specifi
62c0: 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b c options} {sock
62d0: 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 et stdio pcCrash
62e0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
62f0: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
6300: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
6310: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
6320: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
6330: 72 65 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 6f 63 re tls..tls::soc
6340: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
6350: 70 74 20 32 38 32 31 0a 09 70 72 6f 63 20 61 63 pt 2821..proc ac
6360: 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 cept args {..
6370: 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 global x.. s
6380: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
6390: 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 ts ready..set ti
63a0: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
63b0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
63c0: 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 t"]..vwait x..af
63d0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
63e0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
63f0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
6400: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
6410: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
6420: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
6430: 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 gets $f. set
6440: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
6450: 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 31 5d 0a 127.0.0.1 2821].
6460: 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 set p [fconf
6470: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
6480: 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 me]. close $s
6490: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
64a0: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
64b0: 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 append l [llengt
64c0: 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e h $p]. lappen
64d0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 d l [lindex $p 0
64e0: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
64f0: 5b 65 78 70 72 20 5b 6c 69 6e 64 65 78 20 24 70 [expr [lindex $p
6500: 20 32 5d 20 3d 3d 20 32 38 32 31 5d 0a 7d 20 7b 2] == 2821].} {
6510: 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d 0a 74 3 127.0.0.1 0}.t
6520: 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 33 20 7b est socket-7.3 {
6530: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
6540: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
6550: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
6560: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
6570: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
6580: 74 20 32 38 32 32 5d 0a 20 20 20 20 73 65 74 20 t 2822]. set
6590: 6c 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 l [fconfigure $s
65a0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
65b0: 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 6c 6c update. ll
65c0: 65 6e 67 74 68 20 24 6c 0a 7d 20 31 32 0a 74 65 ength $l.} 12.te
65d0: 73 74 20 73 6f 63 6b 65 74 2d 37 2e 34 20 7b 74 st socket-7.4 {t
65e0: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
65f0: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
6600: 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d {socket pcCrash}
6610: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
6620: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
6630: 72 20 61 63 63 65 70 74 20 32 38 32 33 5d 0a 20 r accept 2823].
6640: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
6650: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
6660: 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 x..set x [fconf
6670: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
6680: 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 me]..close $s.
6690: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b }. set s1 [
66a0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 tls::socket [inf
66b0: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 32 33 o hostname] 2823
66c0: 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ]. set timer
66d0: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
66e0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
66f0: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
6700: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
6710: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 mer. close $s
6720: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
6730: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
6740: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 lappend l [linde
6750: 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 x $x 2] [llength
6760: 20 24 78 5d 0a 7d 20 7b 32 38 32 33 20 33 7d 0a $x].} {2823 3}.
6770: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 35 .test socket-7.5
6780: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
6790: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
67a0: 73 7d 20 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f s} {socket unixO
67b0: 72 50 63 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 rPc pcCrash} {.
67c0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
67d0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
67e0: 63 65 70 74 20 32 38 32 39 5d 0a 20 20 20 20 70 cept 2829]. p
67f0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
6800: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 p} {..global x..
6810: 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 set x [fconfigur
6820: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
6830: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
6840: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
6850: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
6860: 31 20 32 38 32 39 5d 0a 20 20 20 20 73 65 74 20 1 2829]. set
6870: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
6880: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
6890: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
68a0: 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 x. after canc
68b0: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
68c0: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
68d0: 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 $s1. set l "
68e0: 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ". lappend l
68f0: 5b 6c 69 6e 64 65 78 20 24 78 20 30 5d 20 5b 6c [lindex $x 0] [l
6900: 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 index $x 2] [lle
6910: 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 31 32 37 2e ngth $x].} {127.
6920: 30 2e 30 2e 31 20 32 38 32 39 20 33 7d 0a 0a 74 0.0.1 2829 3}..t
6930: 65 73 74 20 73 6f 63 6b 65 74 2d 38 2e 31 20 7b est socket-8.1 {
6940: 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 63 20 66 testing -async f
6950: 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 lag on sockets}
6960: 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d {socket pcCrash}
6970: 20 7b 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 {. # NOTE: T
6980: 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 61 69 his test may fai
6990: 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 l on some Solari
69a0: 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 20 49 s 2.4 systems. I
69b0: 66 20 69 74 20 64 6f 65 73 2c 0a 20 20 20 20 23 f it does,. #
69c0: 20 63 68 65 63 6b 20 74 68 61 74 20 79 6f 75 20 check that you
69d0: 68 61 76 65 20 74 68 65 73 65 20 70 61 74 63 68 have these patch
69e0: 65 73 20 69 6e 73 74 61 6c 6c 65 64 20 28 75 73 es installed (us
69f0: 69 6e 67 20 73 68 6f 77 72 65 76 20 2d 70 29 3a ing showrev -p):
6a00: 0a 20 20 20 20 23 0a 20 20 20 20 23 20 31 30 31 . #. # 101
6a10: 39 30 37 2d 30 35 2c 20 31 30 31 39 32 35 2d 30 907-05, 101925-0
6a20: 32 2c 20 31 30 31 39 34 35 2d 31 34 2c 20 31 30 2, 101945-14, 10
6a30: 31 39 35 39 2d 30 33 2c 20 31 30 31 39 36 39 2d 1959-03, 101969-
6a40: 30 35 2c 20 31 30 31 39 37 33 2d 30 33 2c 0a 20 05, 101973-03,.
6a50: 20 20 20 23 20 31 30 31 39 37 37 2d 30 33 2c 20 # 101977-03,
6a60: 31 30 31 39 38 31 2d 30 32 2c 20 31 30 31 39 38 101981-02, 10198
6a70: 35 2d 30 31 2c 20 31 30 32 30 30 31 2d 30 33 2c 5-01, 102001-03,
6a80: 20 31 30 32 30 30 33 2d 30 31 2c 20 31 30 32 30 102003-01, 1020
6a90: 30 37 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 32 07-01,. # 102
6aa0: 30 31 31 2d 30 32 2c 20 31 30 32 30 32 34 2d 30 011-02, 102024-0
6ab0: 31 2c 20 31 30 32 30 33 39 2d 30 31 2c 20 31 30 1, 102039-01, 10
6ac0: 32 30 34 34 2d 30 31 2c 20 31 30 32 30 34 38 2d 2044-01, 102048-
6ad0: 30 31 2c 20 31 30 32 30 36 32 2d 30 33 2c 0a 20 01, 102062-03,.
6ae0: 20 20 20 23 20 31 30 32 30 36 36 2d 30 34 2c 20 # 102066-04,
6af0: 31 30 32 30 37 30 2d 30 31 2c 20 31 30 32 31 30 102070-01, 10210
6b00: 35 2d 30 31 2c 20 31 30 32 31 35 33 2d 30 33 2c 5-01, 102153-03,
6b10: 20 31 30 32 32 31 36 2d 30 31 2c 20 31 30 32 32 102216-01, 1022
6b20: 33 32 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 31 32-01,. # 101
6b30: 38 37 38 2d 30 33 2c 20 31 30 31 38 37 39 2d 30 878-03, 101879-0
6b40: 31 2c 20 31 30 31 38 38 30 2d 30 33 2c 20 31 30 1, 101880-03, 10
6b50: 31 39 33 33 2d 30 31 2c 20 31 30 31 39 35 30 2d 1933-01, 101950-
6b60: 30 31 2c 20 31 30 32 30 33 30 2d 30 31 2c 0a 20 01, 102030-01,.
6b70: 20 20 20 23 20 31 30 32 30 35 37 2d 30 38 2c 20 # 102057-08,
6b80: 31 30 32 31 34 30 2d 30 31 2c 20 31 30 31 39 32 102140-01, 10192
6b90: 30 2d 30 32 2c 20 31 30 31 39 32 31 2d 30 39 2c 0-02, 101921-09,
6ba0: 20 31 30 31 39 32 32 2d 30 37 2c 20 31 30 31 39 101922-07, 1019
6bb0: 32 33 2d 30 33 0a 20 20 20 20 23 0a 20 20 20 20 23-03. #.
6bc0: 23 20 49 66 20 61 66 74 65 72 20 69 6e 73 74 61 # If after insta
6bd0: 6c 6c 69 6e 67 20 74 68 65 73 65 20 70 61 74 63 lling these patc
6be0: 68 65 73 20 79 6f 75 20 61 72 65 20 73 74 69 6c hes you are stil
6bf0: 6c 20 65 78 70 65 72 69 65 6e 63 69 6e 67 20 61 l experiencing a
6c00: 0a 20 20 20 20 23 20 70 72 6f 62 6c 65 6d 2c 20 . # problem,
6c10: 70 6c 65 61 73 65 20 65 6d 61 69 6c 20 6a 79 6c please email jyl
6c20: 40 65 6e 67 2e 73 75 6e 2e 63 6f 6d 2e 20 57 65 @eng.sun.com. We
6c30: 20 68 61 76 65 20 6e 6f 74 20 6f 62 73 65 72 76 have not observ
6c40: 65 64 20 74 68 69 73 0a 20 20 20 20 23 20 66 61 ed this. # fa
6c50: 69 6c 75 72 65 20 6f 6e 20 53 6f 6c 61 72 69 73 ilure on Solaris
6c60: 20 32 2e 35 2c 20 73 6f 20 61 6e 6f 74 68 65 72 2.5, so another
6c70: 20 6f 70 74 69 6f 6e 20 28 69 6e 73 74 65 61 64 option (instead
6c80: 20 6f 66 20 69 6e 73 74 61 6c 6c 69 6e 67 0a 20 of installing.
6c90: 20 20 20 23 20 74 68 65 73 65 20 70 61 74 63 68 # these patch
6ca0: 65 73 29 20 69 73 20 74 6f 20 75 70 67 72 61 64 es) is to upgrad
6cb0: 65 20 74 6f 20 53 6f 6c 61 72 69 73 20 32 2e 35 e to Solaris 2.5
6cc0: 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 .. set s [tls
6cd0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
6ce0: 20 61 63 63 65 70 74 20 32 38 33 30 5d 0a 20 20 accept 2830].
6cf0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
6d00: 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 a p} {..global
6d10: 78 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 x..puts $s bye..
6d20: 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 78 20 close $s..set x
6d30: 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 done. }. s
6d40: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
6d50: 65 74 20 2d 61 73 79 6e 63 20 5b 69 6e 66 6f 20 et -async [info
6d60: 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d 0a hostname] 2830].
6d70: 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 vwait x.
6d80: 73 65 74 20 7a 20 5b 67 65 74 73 20 24 73 31 5d set z [gets $s1]
6d90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
6da0: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
6db0: 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a 74 65 73 set z.} bye..tes
6dc0: 74 20 73 6f 63 6b 65 74 2d 39 2e 31 20 7b 74 65 t socket-9.1 {te
6dd0: 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 65 sting spurious e
6de0: 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 70 vents} {socket p
6df0: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 cCrash} {. se
6e00: 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 t len 0. set
6e10: 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 spurious 0. s
6e20: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 et done 0. pr
6e30: 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 oc readlittle {s
6e40: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 } {..global spur
6e50: 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 ious done len..s
6e60: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d et l [read $s 1]
6e70: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 ..if {[string le
6e80: 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b ngth $l] == 0} {
6e90: 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 .. if {![eof
6ea0: 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 $s]} {...incr sp
6eb0: 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c urious.. } el
6ec0: 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a se {...close $s.
6ed0: 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 ..set done 1..
6ee0: 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 }..} else {..
6ef0: 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 incr len [str
6f00: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 ing length $l]..
6f10: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
6f20: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
6f30: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
6f40: 20 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 -buffering none
6f50: 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 -blocking off..
6f60: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
6f70: 64 61 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 dable [list read
6f80: 6c 69 74 74 6c 65 20 24 73 5d 0a 20 20 20 20 7d little $s]. }
6f90: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6fa0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6fb0: 61 63 63 65 70 74 20 32 38 33 31 5d 0a 20 20 20 accept 2831].
6fc0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
6fd0: 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 ket [info hostna
6fe0: 6d 65 5d 20 32 38 33 31 5d 0a 20 20 20 20 70 75 me] 2831]. pu
6ff0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 ts -nonewline $c
7000: 20 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 012345678901234
7010: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 5678901234567890
7020: 31 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 1234567890123456
7030: 37 38 39 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 789. close $c
7040: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
7050: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
7060: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
7070: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
7080: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
7090: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
70a0: 73 65 20 24 73 0a 20 20 20 20 6c 69 73 74 20 24 se $s. list $
70b0: 73 70 75 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 spurious $len.}
70c0: 7b 30 20 35 30 7d 0a 0a 74 65 73 74 20 73 6f 63 {0 50}..test soc
70d0: 6b 65 74 2d 39 2e 32 20 7b 74 65 73 74 69 6e 67 ket-9.2 {testing
70e0: 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 66 69 async write, fi
70f0: 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 73 68 20 leevents, flush
7100: 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 6b 65 on close} {socke
7110: 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 t pcCrash} {.
7120: 20 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 set firstblock
7130: 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 "". for {set
7140: 69 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 i 0} {$i < 5} {i
7150: 6e 63 72 20 69 7d 20 7b 73 65 74 20 66 69 72 73 ncr i} {set firs
7160: 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 62 tblock "a$firstb
7170: 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 lock$firstblock"
7180: 7d 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 }. set second
7190: 62 6c 6f 63 6b 20 22 22 0a 20 20 20 20 66 6f 72 block "". for
71a0: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
71b0: 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 16} {incr i} {.
71c0: 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b .set secondblock
71d0: 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 "b$secondblock$
71e0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 20 20 20 secondblock".
71f0: 20 7d 0a 20 20 20 20 73 65 74 20 6c 20 5b 74 6c }. set l [tl
7200: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
7210: 72 20 61 63 63 65 70 74 20 32 38 33 32 5d 0a 20 r accept 2832].
7220: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
7230: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
7240: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
7250: 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e g 0 -translation
7260: 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 lf -buffersize
7270: 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 16384 \...-buffe
7280: 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 ring line..filee
7290: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
72a0: 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a 20 "readable $s".
72b0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
72c0: 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 adable {s} {..se
72d0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 66 t l [gets $s]..f
72e0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
72f0: 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 able {}..after 1
7300: 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 000 respond $s.
7310: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
7320: 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f spond {s} {..glo
7330: 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 bal firstblock..
7340: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
7350: 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 $s $firstblock..
7360: 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 65 after 1000 write
7370: 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 data $s. }.
7380: 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 proc writedata
7390: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 {s} {..global s
73a0: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 74 73 econdblock..puts
73b0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
73c0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f secondblock..clo
73d0: 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 se $s. }.
73e0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
73f0: 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d et [info hostnam
7400: 65 5d 20 32 38 33 32 5d 0a 20 20 20 20 66 63 6f e] 2832]. fco
7410: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 nfigure $s -bloc
7420: 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 king 0 -trans lf
7430: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
7440: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 . set count 0
7450: 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c . puts $s hel
7460: 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 lo. proc read
7470: 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c it {s} {..global
7480: 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 count done..set
7490: 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e l [read $s]..in
74a0: 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 cr count [string
74b0: 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 length $l]..if
74c0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
74d0: 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 close $s..
74e0: 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 set done 1..}.
74f0: 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e }. fileeven
7500: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
7510: 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 65 eadit $s". se
7520: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
7530: 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 0000 "set done t
7540: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
7550: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 wait done. af
7560: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
7570: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 6c 0a 20 r. close $l.
7580: 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 set count.} 6
7590: 35 35 36 36 0a 0a 74 65 73 74 20 73 6f 63 6b 65 5566..test socke
75a0: 74 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 20 45 t-9.3 {testing E
75b0: 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b OF stickyness} {
75c0: 73 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d 20 socket pcCrash}
75d0: 7b 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 {. proc count
75e0: 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 _to_eof {s} {..g
75f0: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
7600: 20 74 69 6d 65 72 0a 09 73 65 74 20 6c 20 5b 67 timer..set l [g
7610: 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f ets $s]..if {[eo
7620: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e f $s]} {.. in
7630: 63 72 20 63 6f 75 6e 74 0a 09 20 20 20 20 69 66 cr count.. if
7640: 20 7b 24 63 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a {$count > 9} {.
7650: 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 ..close $s...set
7660: 20 64 6f 6e 65 20 74 72 75 65 0a 09 09 73 65 74 done true...set
7670: 20 63 6f 75 6e 74 20 7b 65 6f 66 20 69 73 20 73 count {eof is s
7680: 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 ticky}...after c
7690: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 20 20 ancel $timer..
76a0: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
76b0: 20 70 72 6f 63 20 74 69 6d 65 72 70 72 6f 63 20 proc timerproc
76c0: 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e {} {..global don
76d0: 65 20 63 6f 75 6e 74 20 63 0a 09 73 65 74 20 64 e count c..set d
76e0: 6f 6e 65 20 74 72 75 65 0a 09 73 65 74 20 63 6f one true..set co
76f0: 75 6e 74 20 7b 74 69 6d 65 72 20 77 65 6e 74 20 unt {timer went
7700: 6f 66 66 2c 20 65 6f 66 20 69 73 20 6e 6f 74 20 off, eof is not
7710: 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 sticky}..close $
7720: 63 0a 20 20 20 20 7d 09 0a 20 20 20 20 73 65 74 c. }.. set
7730: 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 73 65 74 count 0. set
7740: 20 64 6f 6e 65 20 66 61 6c 73 65 0a 20 20 20 20 done false.
7750: 70 72 6f 63 20 77 72 69 74 65 5f 74 68 65 6e 5f proc write_then_
7760: 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 75 74 close {s} {..put
7770: 73 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 s $s bye..close
7780: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f $s. }. pro
7790: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
77a0: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
77b0: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
77c0: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c e -translation l
77d0: 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 f..fileevent $s
77e0: 77 72 69 74 61 62 6c 65 20 22 77 72 69 74 65 5f writable "write_
77f0: 74 68 65 6e 5f 63 6c 6f 73 65 20 24 73 22 0a 20 then_close $s".
7800: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
7810: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
7820: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 33 5d ver accept 2833]
7830: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
7840: 3a 73 6f 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f :socket [info ho
7850: 73 74 6e 61 6d 65 5d 20 32 38 33 33 5d 0a 20 20 stname] 2833].
7860: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 fconfigure $c
7870: 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 20 2d 62 -blocking off -b
7880: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
7890: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 ranslation lf.
78a0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
78b0: 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 eadable "count_t
78c0: 6f 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 o_eof $c". se
78d0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
78e0: 30 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 000 timerproc].
78f0: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
7900: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
7910: 65 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 et count.} {eof
7920: 69 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f is sticky}..remo
7930: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 veFile script..t
7940: 65 73 74 20 73 6f 63 6b 65 74 2d 31 30 2e 31 20 est socket-10.1
7950: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
7960: 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 accept callback
7970: 65 72 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 error handling}
7980: 7b 73 6f 63 6b 65 74 20 70 63 43 72 61 73 68 7d {socket pcCrash}
7990: 20 7b 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 {. set goter
79a0: 72 6f 72 20 30 0a 20 20 20 20 70 72 6f 63 20 62 ror 0. proc b
79b0: 67 65 72 72 6f 72 20 61 72 67 73 20 7b 67 6c 6f gerror args {glo
79c0: 62 61 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 65 bal goterror; se
79d0: 74 20 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 20 t goterror 1}.
79e0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
79f0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
7a00: 65 70 74 20 32 38 39 38 5d 0a 20 20 20 20 70 72 ept 2898]. pr
7a10: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
7a20: 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 72 72 } {close $s; err
7a30: 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 or}. set c [t
7a40: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
7a50: 2e 30 2e 31 20 32 38 39 38 5d 0a 20 20 20 20 76 .0.1 2898]. v
7a60: 77 61 69 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 wait goterror.
7a70: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
7a80: 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 lose $c. set
7a90: 67 6f 74 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 goterror.} 1..te
7aa0: 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 20 7b st socket-11.1 {
7ab0: 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 tcp connection}
7ac0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
7ad0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
7ae0: 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 {. sendComma
7af0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
7b00: 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 20 9_1_test_server
7b10: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
7b20: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 rver accept \...
7b30: 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 -certfile [file
7b40: 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 join [pwd] certs
7b50: 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 server.pem] \..
7b60: 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a .-cafile [file j
7b70: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
7b80: 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 caFile.pem] \...
7b90: 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a -keyfile [file j
7ba0: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
7bb0: 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 32 38 skey.pem] \...28
7bc0: 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 34]..proc accept
7bd0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
7be0: 70 75 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 20 puts $s done..
7bf0: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
7c00: 20 24 73 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 $s.. close $
7c10: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
7c20: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
7c30: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
7c40: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
7c50: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
7c60: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
7c70: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
7c80: 65 53 65 72 76 65 72 49 50 20 32 38 33 34 5d 0a eServerIP 2834].
7c90: 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 set r [gets
7ca0: 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s]. close $s
7cb0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
7cc0: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 {close $socket9
7cd0: 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _1_test_server}.
7ce0: 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e 65 set r.} done
7cf0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 ..test socket-11
7d00: 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 .2 {client speci
7d10: 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b fies its port} {
7d20: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
7d30: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
7d40: 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 {. if {[info
7d50: 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a exists port]} {.
7d60: 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d .incr port. }
7d70: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 else {..set por
7d80: 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b 20 5b t [expr 2048 + [
7d90: 70 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 20 7d pid]%1024]. }
7da0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
7db0: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f {..set socket9_
7dc0: 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 2_test_server [t
7dd0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
7de0: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 er accept \...-c
7df0: 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f ertfile [file jo
7e00: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 in [pwd] certs s
7e10: 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d erver.pem] \...-
7e20: 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 cafile [file joi
7e30: 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 n [pwd] certs ca
7e40: 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b File.pem] \...-k
7e50: 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 eyfile [file joi
7e60: 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b n [pwd] certs sk
7e70: 65 79 2e 70 65 6d 5d 20 5c 0a 09 20 20 20 20 32 ey.pem] \.. 2
7e80: 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 835]..proc accep
7e90: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
7ea0: 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 20 puts $s $p..
7eb0: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
7ec0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
7ed0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
7ee0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
7ef0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
7f00: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
7f10: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
7f20: 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 -myport $port
7f30: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
7f40: 32 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 20 2835]. set r
7f50: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c [gets $s]. cl
7f60: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 ose $s. sendC
7f70: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
7f80: 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 ocket9_2_test_se
7f90: 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 72 rver}. if {$r
7fa0: 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 65 == $port} {..se
7fb0: 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 20 t result ok.
7fc0: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 } else {..set re
7fd0: 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 20 sult broken.
7fe0: 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 }. set result
7ff0: 0a 7d 20 6f 6b 0a 74 65 73 74 20 73 6f 63 6b 65 .} ok.test socke
8000: 74 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 t-11.3 {trying t
8010: 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 o connect, no se
8020: 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f rver} {socket do
8030: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8040: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 erver} {. set
8050: 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 status ok. i
8060: 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 f {![catch {set
8070: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 s [tls::socket $
8080: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 70 20 32 remoteServerIp 2
8090: 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 836]}]} {..if {!
80a0: 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 7d [catch {gets $s}
80b0: 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 ]} {.. set st
80c0: 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 atus broken..}..
80d0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 close $s. }.
80e0: 20 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 set status.}
80f0: 6f 6b 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 ok.test socket-1
8100: 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 1.4 {remote echo
8110: 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 , one line} {soc
8120: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
8130: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
8140: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
8150: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 ..set socket10_6
8160: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
8170: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
8180: 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 09 r accept 2836]..
8190: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
81a0: 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 p} {.. filee
81b0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
81c0: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
81d0: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
81e0: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
81f0: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
8200: 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 crlf..}..proc ec
8210: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 ho {s} {.. se
8220: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 t l [gets $s]..
8230: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
8240: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 {...close $s..
8250: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 } else {...pu
8260: 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a ts $s $l.. }.
8270: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
8280: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
8290: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
82a0: 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2836]. fconfi
82b0: 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 gure $f -transla
82c0: 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 tion crlf -buffe
82d0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 ring line. pu
82e0: 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 ts $f hello.
82f0: 73 65 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a set r [gets $f].
8300: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
8310: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
8320: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f ose $socket10_6_
8330: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
8340: 20 73 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 74 set r.} hello.t
8350: 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 35 20 est socket-11.5
8360: 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 {remote echo, 50
8370: 20 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 lines} {socket
8380: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
8390: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
83a0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
83b0: 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 t socket10_7_tes
83c0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
83d0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
83e0: 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 cept 2836]..proc
83f0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
8400: 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 {.. fileevent
8410: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
8420: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
8430: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
8440: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
8450: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
8460: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
8470: 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 s} {.. set l
8480: 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 [gets $s].. i
8490: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
84a0: 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d .close $s.. }
84b0: 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 else {...puts $
84c0: 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 s $l.. }..}.
84d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b }. set f [
84e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d tls::socket $rem
84f0: 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 oteServerIP 2836
8500: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
8510: 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e $f -translation
8520: 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 crlf -buffering
8530: 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 line. for {s
8540: 65 74 20 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 et cnt 0} {$cnt
8550: 3c 20 35 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d < 50} {incr cnt}
8560: 20 7b 0a 09 70 75 74 73 20 24 66 20 22 68 65 6c {..puts $f "hel
8570: 6c 6f 2c 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b lo, $cnt"..if {[
8580: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b string compare [
8590: 67 65 74 73 20 24 66 5d 20 22 68 65 6c 6c 6f 2c gets $f] "hello,
85a0: 20 24 63 6e 74 22 5d 20 21 3d 20 30 7d 20 7b 0a $cnt"] != 0} {.
85b0: 09 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 . break..}.
85c0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
85d0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
85e0: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
85f0: 30 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0_7_test_server}
8600: 0a 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 . set cnt.} 5
8610: 30 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f 0.# Macintosh so
8620: 63 6b 65 74 73 20 63 61 6e 20 68 61 76 65 20 6d ckets can have m
8630: 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 ore than one ser
8640: 76 65 72 20 70 65 72 20 70 6f 72 74 0a 69 66 20 ver per port.if
8650: 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 {$tcl_platform(p
8660: 6c 61 74 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 latform) == "mac
8670: 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 intosh"} {. s
8680: 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c et conflictResul
8690: 74 20 7b 30 20 32 38 33 36 7d 0a 7d 20 65 6c 73 t {0 2836}.} els
86a0: 65 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 e {. set conf
86b0: 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 lictResult {1 {c
86c0: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
86d0: 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 ket: address alr
86e0: 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a eady in use}}.}.
86f0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 36 test socket-11.6
8700: 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 {socket conflic
8710: 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 t} {socket doTes
8720: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
8730: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 31 er} {. set s1
8740: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
8750: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
8760: 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 6]. if {[catc
8770: 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a h {set s2 [tls::
8780: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
8790: 63 63 65 70 74 20 32 38 33 36 5d 7d 20 6d 73 67 ccept 2836]} msg
87a0: 5d 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 ]} {..set result
87b0: 20 5b 6c 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 [list 1 $msg].
87c0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
87d0: 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 result [list 0
87e0: 5b 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 [lindex [fconfig
87f0: 75 72 65 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d ure $s2 -socknam
8800: 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 e] 2]]..close $s
8810: 32 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 2. }. clos
8820: 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 72 65 e $s1. set re
8830: 73 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 sult.} $conflict
8840: 52 65 73 75 6c 74 0a 74 65 73 74 20 73 6f 63 6b Result.test sock
8850: 65 74 2d 31 31 2e 37 20 7b 73 65 72 76 65 72 20 et-11.7 {server
8860: 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 with several cli
8870: 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ents} {socket do
8880: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8890: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
88a0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
88b0: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
88c0: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
88d0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
88e0: 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 pt 2836]..proc a
88f0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
8900: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
8910: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
8920: 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e ne.. fileeven
8930: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
8940: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a ist echo $s]..}.
8950: 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b .proc echo {s} {
8960: 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 .. set l [get
8970: 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b s $s].. if {[
8980: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f eof $s]} {...clo
8990: 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 se $s.. } els
89a0: 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c e {...puts $s $l
89b0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
89c0: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
89d0: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
89e0: 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 ServerIP 2836].
89f0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
8a00: 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 1 -buffering lin
8a10: 65 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c e. set s2 [tl
8a20: 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 s::socket $remot
8a30: 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a eServerIP 2836].
8a40: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
8a50: 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s2 -buffering li
8a60: 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 ne. set s3 [t
8a70: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
8a80: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d teServerIP 2836]
8a90: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
8aa0: 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s3 -buffering l
8ab0: 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 ine. for {set
8ac0: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d i 0} {$i < 100}
8ad0: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 {incr i} {..put
8ae0: 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a 09 s $s1 hello,s1..
8af0: 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 24 gets $s1..puts $
8b00: 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 74 s2 hello,s2..get
8b10: 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 s $s2..puts $s3
8b20: 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 24 hello,s3..gets $
8b30: 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f s3. }. clo
8b40: 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 se $s1. close
8b50: 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s2. close $
8b60: 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 s3. sendComma
8b70: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
8b80: 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 t10_9_test_serve
8b90: 72 7d 0a 20 20 20 20 73 65 74 20 69 0a 7d 20 31 r}. set i.} 1
8ba0: 30 30 20 20 20 20 0a 74 65 73 74 20 73 6f 63 6b 00 .test sock
8bb0: 65 74 2d 31 31 2e 38 20 7b 63 6c 69 65 6e 74 20 et-11.8 {client
8bc0: 77 69 74 68 20 73 65 76 65 72 61 6c 20 73 65 72 with several ser
8bd0: 76 65 72 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f vers} {socket do
8be0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
8bf0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
8c00: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
8c10: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
8c20: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
8c30: 34 30 30 33 22 20 34 30 30 33 5d 0a 09 73 65 74 4003" 4003]..set
8c40: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
8c50: 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 -server "accept
8c60: 20 34 30 30 34 22 20 34 30 30 34 5d 0a 09 73 65 4004" 4004]..se
8c70: 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s3 [tls::socke
8c80: 74 20 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 t -server "accep
8c90: 74 20 34 30 30 35 22 20 34 30 30 35 5d 0a 09 70 t 4005" 4005]..p
8ca0: 72 6f 63 20 61 63 63 65 70 74 20 7b 6d 70 20 73 roc accept {mp s
8cb0: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 a p} {.. put
8cc0: 73 20 24 73 20 24 6d 70 0a 09 20 20 20 20 63 6c s $s $mp.. cl
8cd0: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
8ce0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
8cf0: 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 :socket $remoteS
8d00: 65 72 76 65 72 49 50 20 34 30 30 33 5d 0a 20 20 erverIP 4003].
8d10: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
8d20: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
8d30: 76 65 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 verIP 4004].
8d40: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
8d50: 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ket $remoteServe
8d60: 72 49 50 20 34 30 30 35 5d 0a 20 20 20 20 73 65 rIP 4005]. se
8d70: 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 t l "". lappe
8d80: 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 31 5d 20 nd l [gets $s1]
8d90: 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 6f 66 20 [gets $s1] [eof
8da0: 24 73 31 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 $s1] [gets $s2]
8db0: 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 6f 66 20 [gets $s2] [eof
8dc0: 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 20 24 73 $s2] \..[gets $s
8dd0: 33 5d 20 5b 67 65 74 73 20 24 73 33 5d 20 5b 65 3] [gets $s3] [e
8de0: 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 6c 6f 73 of $s3]. clos
8df0: 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 e $s1. close
8e00: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
8e10: 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 3. sendComman
8e20: 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 31 0a 09 d {..close $s1..
8e30: 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 6f 73 65 close $s2..close
8e40: 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 73 $s3. }. s
8e50: 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 7b 7d 20 et l.} {4003 {}
8e60: 31 20 34 30 30 34 20 7b 7d 20 31 20 34 30 30 35 1 4004 {} 1 4005
8e70: 20 7b 7d 20 31 7d 0a 74 65 73 74 20 73 6f 63 6b {} 1}.test sock
8e80: 65 74 2d 31 31 2e 39 20 7b 61 63 63 65 70 74 20 et-11.9 {accept
8e90: 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 callback error}
8ea0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
8eb0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
8ec0: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
8ed0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
8ee0: 72 20 61 63 63 65 70 74 20 32 38 33 36 5d 0a 20 r accept 2836].
8ef0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
8f00: 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 s a p} {expr 10
8f10: 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 / 0}. proc bg
8f20: 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c error args {..gl
8f30: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 obal x..set x $a
8f40: 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 rgs. }. if
8f50: 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f {[catch {sendCo
8f60: 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 mmand {.. set
8f70: 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 peername [fconf
8f80: 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 igure $callerSoc
8f90: 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 ket -peername]..
8fa0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
8fb0: 73 6f 63 6b 65 74 20 5b 6c 69 6e 64 65 78 20 24 socket [lindex $
8fc0: 70 65 65 72 6e 61 6d 65 20 30 5d 20 32 38 33 36 peername 0] 2836
8fd0: 5d 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a ].. close $s.
8fe0: 20 20 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b . }} msg]} {
8ff0: 0a 09 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f ..close $s..erro
9000: 72 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 r $msg. }.
9010: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
9020: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
9030: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
9040: 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 wait x. after
9050: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
9060: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
9070: 72 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b rename bgerror {
9080: 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b }. set x.} {{
9090: 64 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d divide by zero}}
90a0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e .test socket-11.
90b0: 31 30 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 10 {testing sock
90c0: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
90d0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ons} {socket doT
90e0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
90f0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
9100: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
9110: 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f ocket10_12_test_
9120: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
9130: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
9140: 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 pt 2836]..proc a
9150: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 ccept {s a p} {c
9160: 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 lose $s}. }.
9170: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
9180: 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 ocket $remoteSer
9190: 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 verIP 2836].
91a0: 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 set p [fconfigur
91b0: 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a e $s -peername].
91c0: 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f 6e 66 set n [fconf
91d0: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
91e0: 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 me]. set l ""
91f0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
9200: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b 6c 6c lindex $p 2] [ll
9210: 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 ength $p] [lleng
9220: 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f 73 65 th $p]. close
9230: 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s. sendComm
9240: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
9250: 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 65 72 et10_12_test_ser
9260: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d ver}. set l.}
9270: 20 7b 32 38 33 36 20 33 20 33 7d 0a 74 65 73 74 {2836 3 3}.test
9280: 20 73 6f 63 6b 65 74 2d 31 31 2e 31 31 20 7b 74 socket-11.11 {t
9290: 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 20 esting spurious
92a0: 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 events} {socket
92b0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
92c0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
92d0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
92e0: 74 20 73 6f 63 6b 65 74 31 30 5f 31 33 5f 74 65 t socket10_13_te
92f0: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
9300: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
9310: 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f ccept 2836]..pro
9320: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
9330: 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 {.. fconfigu
9340: 72 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 re $s -translati
9350: 6f 6e 20 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 on "auto lf"..
9360: 20 20 61 66 74 65 72 20 31 30 30 20 77 72 69 74 after 100 writ
9370: 65 73 6f 6d 65 20 24 73 0a 09 7d 0a 09 70 72 6f esome $s..}..pro
9380: 63 20 77 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 c writesome {s}
9390: 7b 0a 09 20 20 20 20 66 6f 72 20 7b 73 65 74 20 {.. for {set
93a0: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
93b0: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 {incr i} {...put
93c0: 73 20 24 73 20 22 6c 69 6e 65 20 24 69 20 66 72 s $s "line $i fr
93d0: 6f 6d 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 om remote server
93e0: 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 63 6c ".. }.. cl
93f0: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
9400: 20 20 20 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 set len 0.
9410: 20 20 73 65 74 20 73 70 75 72 69 6f 75 73 20 30 set spurious 0
9420: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
9430: 20 20 20 20 70 72 6f 63 20 72 65 61 64 6c 69 74 proc readlit
9440: 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 tle {s} {..globa
9450: 6c 20 73 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 l spurious done
9460: 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 len..set l [read
9470: 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 $s 1]..if {[str
9480: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d ing length $l] =
9490: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b = 0} {.. if {
94a0: 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 ![eof $s]} {...i
94b0: 6e 63 72 20 73 70 75 72 69 6f 75 73 0a 09 20 20 ncr spurious..
94c0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f } else {...clo
94d0: 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 se $s...set done
94e0: 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 1.. }..} els
94f0: 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 e {.. incr le
9500: 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 n [string length
9510: 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 $l]..}. }.
9520: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
9530: 63 6b 65 74 20 24 72 65 6d 6f 74 65 53 65 72 76 cket $remoteServ
9540: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 erIP 2836]. f
9550: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
9560: 61 62 6c 65 20 22 72 65 61 64 6c 69 74 74 6c 65 able "readlittle
9570: 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d $c". set tim
9580: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
9590: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
95a0: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
95b0: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
95c0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
95d0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
95e0: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 33 ose $socket10_13
95f0: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
9600: 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 list $spurious
9610: 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d $len.} {0 2690}
9620: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e .test socket-11.
9630: 31 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 12 {testing EOF
9640: 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 73 6f 63 stickyness} {soc
9650: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9660: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9670: 20 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 30 set counter 0
9680: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
9690: 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 proc count_u
96a0: 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 p {s} {..global
96b0: 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 counter done aft
96c0: 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 er_id..set l [ge
96d0: 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 ts $s]..if {[eof
96e0: 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 $s]} {.. inc
96f0: 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 r counter.. i
9700: 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d f {$counter > 9}
9710: 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 {...set done {E
9720: 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 OF is sticky}...
9730: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 66 after cancel $af
9740: 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 ter_id...close $
9750: 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 s.. }..}.
9760: 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 64 }. proc timed
9770: 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 _out {} {..globa
9780: 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f l c done..set do
9790: 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 ne {timed_out, E
97a0: 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 OF is not sticky
97b0: 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 }..close $c.
97c0: 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e }. sendComman
97d0: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 d {..set socket1
97e0: 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 0_14_test_server
97f0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
9800: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
9810: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
9820: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 61 {s a p} {.. a
9830: 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 24 fter 100 close $
9840: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
9850: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
9860: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
9870: 50 20 32 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 P 2836]. file
9880: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
9890: 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a e "count_up $c".
98a0: 20 20 20 20 73 65 74 20 61 66 74 65 72 5f 69 64 set after_id
98b0: 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 6d [after 1000 tim
98c0: 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 ed_out]. vwai
98d0: 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 t done. sendC
98e0: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
98f0: 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f ocket10_14_test_
9900: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
9910: 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 done.} {EOF is s
9920: 74 69 63 6b 79 7d 0a 74 65 73 74 20 73 6f 63 6b ticky}.test sock
9930: 65 74 2d 31 31 2e 31 33 20 7b 74 65 73 74 69 6e et-11.13 {testin
9940: 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 61 g async write, a
9950: 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 73 79 6e sync flush, asyn
9960: 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 c close} \..{soc
9970: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9980: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9990: 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b proc readit {
99a0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
99b0: 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b nt done..set l [
99c0: 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 read $s]..incr c
99d0: 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e ount [string len
99e0: 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f gth $l]..if {[eo
99f0: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c f $s]} {.. cl
9a00: 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 74 20 ose $s.. set
9a10: 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a done 1..}. }.
9a20: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9a30: 7b 0a 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 {..set firstbloc
9a40: 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 k ""..for {set i
9a50: 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 0} {$i < 5} {in
9a60: 63 72 20 69 7d 20 7b 0a 09 09 73 65 74 20 66 69 cr i} {...set fi
9a70: 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 rstblock "a$firs
9a80: 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 tblock$firstbloc
9a90: 6b 22 0a 09 7d 0a 09 73 65 74 20 73 65 63 6f 6e k"..}..set secon
9aa0: 64 62 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b dblock ""..for {
9ab0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
9ac0: 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 6} {incr i} {..
9ad0: 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f set secondblo
9ae0: 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 ck "b$secondbloc
9af0: 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 09 k$secondblock"..
9b00: 7d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 }..set l [tls::s
9b10: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
9b20: 63 65 70 74 20 32 38 34 35 5d 0a 09 70 72 6f 63 cept 2845]..proc
9b30: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
9b40: 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 {.. fconfigur
9b50: 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $s -blocking 0
9b60: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
9b70: 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 33 -buffersize 163
9b80: 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 84 \...-bufferin
9b90: 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 g line.. file
9ba0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
9bb0: 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a e "readable $s".
9bc0: 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 61 62 6c .}..proc readabl
9bd0: 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 e {s} {.. set
9be0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
9bf0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
9c00: 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 20 20 20 eadable {}..
9c10: 61 66 74 65 72 20 31 30 30 30 20 72 65 73 70 6f after 1000 respo
9c20: 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 72 nd $s..}..proc r
9c30: 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 20 20 espond {s} {..
9c40: 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c global firstbl
9c50: 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 2d 6e ock.. puts -n
9c60: 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 66 69 72 onewline $s $fir
9c70: 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 61 66 74 stblock.. aft
9c80: 65 72 20 31 30 30 30 20 77 72 69 74 65 64 61 74 er 1000 writedat
9c90: 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 72 a $s..}..proc wr
9ca0: 69 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 20 itedata {s} {..
9cb0: 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 6f 6e 64 global second
9cc0: 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 20 block.. puts
9cd0: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 -nonewline $s $s
9ce0: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 econdblock..
9cf0: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
9d00: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
9d10: 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f 74 65 ::socket $remote
9d20: 53 65 72 76 65 72 49 50 20 32 38 34 35 5d 0a 20 ServerIP 2845].
9d30: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
9d40: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 -blocking 0 -tr
9d50: 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e ans lf -bufferin
9d60: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 g line. set c
9d70: 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 ount 0. puts
9d80: 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c $s hello. fil
9d90: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
9da0: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 le "readit $s".
9db0: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
9dc0: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 ter 10000 "set d
9dd0: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a one timed_out"].
9de0: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
9df0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
9e00: 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 $timer. sendC
9e10: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c ommand {close $l
9e20: 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a }. set count.
9e30: 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 73 6f } 65566..test so
9e40: 63 6b 65 74 2d 31 32 2e 31 20 7b 74 65 73 74 69 cket-12.1 {testi
9e50: 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f ng inheritance o
9e60: 66 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 73 f server sockets
9e70: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
9e80: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
9e90: 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rver} {. remo
9ea0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 veFile script1.
9eb0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
9ec0: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
9ed0: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
9ee0: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
9ef0: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
9f00: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
9f10: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
9f20: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
9f30: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
9f40: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
9f50: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
9f60: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
9f70: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
9f80: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
9f90: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
9fa0: 20 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 # Script2 creat
9fb0: 65 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f es the server so
9fc0: 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 cket, launches s
9fd0: 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 cript1,. # wa
9fe0: 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e its a second, an
9ff0: 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 d exits. The se
a000: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c rver socket will
a010: 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c now. # be cl
a020: 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 osed unless scri
a030: 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 pt1 inherited it
a040: 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 ... set f [op
a050: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
a060: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
a070: 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 set tcltest $::t
a080: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d cltest::tcltest]
a090: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
a0a0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
a0b0: 74 63 6c 74 65 73 74 0a 09 73 65 74 20 66 20 5b tcltest..set f [
a0c0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
a0d0: 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d ver accept 2828]
a0e0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 ..proc accept {
a0f0: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 20 7d file addr port }
a100: 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 66 {.. close $f
a110: 69 6c 65 0a 09 7d 0a 09 65 78 65 63 20 24 3a 3a ile..}..exec $::
a120: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
a130: 20 73 63 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 script1 &..clos
a140: 65 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 30 e $f..after 1000
a150: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
a160: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
a170: 6c 6f 73 65 20 24 66 0a 09 0a 20 20 20 20 23 20 lose $f... #
a180: 4c 61 75 6e 63 68 20 73 63 72 69 70 74 32 20 61 Launch script2 a
a190: 6e 64 20 77 61 69 74 20 35 20 73 65 63 6f 6e 64 nd wait 5 second
a1a0: 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 s.. exec $::t
a1b0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
a1c0: 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 61 66 script2 &. af
a1d0: 74 65 72 20 35 30 30 30 20 7b 20 73 65 74 20 6f ter 5000 { set o
a1e0: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 20 7d k_to_proceed 1 }
a1f0: 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f . vwait ok_to
a200: 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 23 20 _proceed.. #
a210: 49 66 20 77 65 20 63 61 6e 20 73 74 69 6c 6c 20 If we can still
a220: 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 20 73 connect to the s
a230: 65 72 76 65 72 2c 20 74 68 65 20 73 6f 63 6b 65 erver, the socke
a240: 74 20 67 6f 74 20 69 6e 68 65 72 69 74 65 64 2e t got inherited.
a250: 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 .. if {[catch
a260: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 {tls::socket 12
a270: 37 2e 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 7.0.0.1 2828} ms
a280: 67 5d 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 g]} {..set x {se
a290: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
a2a0: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 not inherited}.
a2b0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f } else {..clo
a2c0: 73 65 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b se $msg..set x {
a2d0: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 server socket wa
a2e0: 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 s inherited}.
a2f0: 20 7d 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 }.. removeFi
a300: 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 le script1. r
a310: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
a320: 32 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 2. set x.} {s
a330: 65 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 erver socket was
a340: 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a not inherited}.
a350: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 32 2e 32 test socket-12.2
a360: 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 {testing inheri
a370: 74 61 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 tance of client
a380: 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 sockets} \..{soc
a390: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
a3a0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
a3b0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
a3c0: 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 ript1. remove
a3d0: 46 69 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 File script2..
a3e0: 20 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a # Script1 is j
a3f0: 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 ust a 10 second
a400: 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 delay. If the s
a410: 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 erver socket.
a420: 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c # is inherited,
a430: 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 it will be held
a440: 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 open for 10 sec
a450: 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 onds.. set f
a460: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
a470: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
a480: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
a490: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
a4a0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
a4b0: 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 $f.. # Script
a4c0: 32 20 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 2 opens the clie
a4d0: 6e 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 nt socket and wr
a4e0: 69 74 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 ites to it. It
a4f0: 74 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 then. # launc
a500: 68 65 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 hes script1 and
a510: 65 78 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 exits. If the c
a520: 68 69 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 hild process inh
a530: 65 72 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 erited the. #
a540: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 client socket,
a550: 74 68 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 the socket will
a560: 73 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a still be open...
a570: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
a580: 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 script2 w]. p
a590: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
a5a0: 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 63 6c 74 tcltest $::tclt
a5b0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 est::tcltest].
a5c0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 73 65 74 puts $f {..set
a5d0: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
a5e0: 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 5d 0a 127.0.0.1 2829].
a5f0: 09 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 .exec $::tcltest
a600: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
a610: 31 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 1 &..puts $f tes
a620: 74 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 ting..flush $f..
a630: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
a640: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
a650: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
a660: 66 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 f.. # Create
a670: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
a680: 74 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 t.. set serve
a690: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
a6a0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
a6b0: 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 29]. proc acc
a6c0: 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 ept { file host
a6d0: 70 6f 72 74 20 7d 20 7b 0a 0a 09 23 20 57 68 65 port } {...# Whe
a6e0: 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e n the client con
a6f0: 6e 65 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 nects, establish
a700: 20 74 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 the read handle
a710: 72 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 r..global server
a720: 0a 09 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a ..close $server.
a730: 09 66 69 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 .fileevent $file
a740: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
a750: 67 65 74 64 61 74 61 20 24 66 69 6c 65 5d 0a 09 getdata $file]..
a760: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 fconfigure $file
a770: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
a780: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 72 65 -blocking 0..re
a790: 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 turn. }. p
a7a0: 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 roc getdata { fi
a7b0: 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 le } {...# Read
a7c0: 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 handler on the a
a7d0: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a ccepted socket..
a7e0: 09 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 .global x..globa
a7f0: 6c 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 l failed..set st
a800: 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 atus [catch {rea
a810: 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 d $file} data]..
a820: 69 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 if {$status != 0
a830: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b } {.. set x {
a840: 72 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 read failed, err
a850: 6f 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 or was $data}..
a860: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
a870: 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 $file }..} else
a880: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
a890: 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b are {} $data]} {
a8a0: 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c ..} elseif {[fbl
a8b0: 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a ocked $file]} {.
a8c0: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 .} elseif {[eof
a8d0: 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 $file]} {.. i
a8e0: 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 f {$failed} {...
a8f0: 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f set x {client so
a900: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
a910: 65 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ed}.. } else
a920: 7b 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 6e {...set x {clien
a930: 74 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 t socket was not
a940: 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 inherited}..
a950: 20 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 }.. catch {
a960: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d close $file }..}
a970: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 else {.. set
a980: 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 x {impossible c
a990: 61 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 ase}.. catch
a9a0: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
a9b0: 09 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d .}..return. }
a9c0: 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 .. # If the s
a9d0: 6f 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 ocket doesn't hi
a9e0: 74 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e t end-of-file in
a9f0: 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 5 seconds, the.
aa00: 20 20 20 20 23 20 73 63 72 69 70 74 31 20 70 72 # script1 pr
aa10: 6f 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 ocess must have
aa20: 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 6c inherited the cl
aa30: 69 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 ient... set f
aa40: 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 ailed 0. afte
aa50: 72 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 r 5000 [list set
aa60: 20 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 failed 1]..
aa70: 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 # Launch the scr
aa80: 69 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 ipt2 process..
aa90: 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 exec $::tcltes
aaa0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
aab0: 74 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 t2 &.. vwait
aac0: 78 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c x. if {!$fail
aad0: 65 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 ed} {..vwait fai
aae0: 6c 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 led. }. re
aaf0: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 moveFile script1
ab00: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
ab10: 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 script2. set
ab20: 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b x.} {client sock
ab30: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
ab40: 69 74 65 64 7d 0a 74 65 73 74 20 73 6f 63 6b 65 ited}.test socke
ab50: 74 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 t-12.3 {testing
ab60: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 inheritance of a
ab70: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d ccepted sockets}
ab80: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 \..{socket doTe
ab90: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
aba0: 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ver} {. remov
abb0: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
abc0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
abd0: 69 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 ipt2.. set f
abe0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
abf0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
ac00: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
ac10: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
ac20: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
ac30: 24 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f.. set f [o
ac40: 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 pen script2 w].
ac50: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
ac60: 20 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a set tcltest $::
ac70: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
ac80: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
ac90: 09 73 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 .set server [tls
aca0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
acb0: 20 61 63 63 65 70 74 20 32 39 33 30 5d 0a 09 70 accept 2930]..p
acc0: 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c roc accept { fil
acd0: 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a e host port } {.
ace0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 74 . global tclt
acf0: 65 73 74 0a 09 20 20 20 20 70 75 74 73 20 24 66 est.. puts $f
ad00: 69 6c 65 20 7b 74 65 73 74 20 64 61 74 61 20 6f ile {test data o
ad10: 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 20 65 n socket}.. e
ad20: 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a xec $::tcltest::
ad30: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 20 tcltest script1
ad40: 26 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 &.. after 100
ad50: 30 20 65 78 69 74 0a 09 7d 0a 09 76 77 61 69 74 0 exit..}..vwait
ad60: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
ad70: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
ad80: 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 # Launch the sc
ad90: 72 69 70 74 32 20 70 72 6f 63 65 73 73 20 61 6e ript2 process an
ada0: 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e d connect to it.
adb0: 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 See how long.
adc0: 20 20 20 23 20 74 68 65 20 73 6f 63 6b 65 74 20 # the socket
add0: 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 stays open..
ade0: 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a exec $::tcltest:
adf0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 :tcltest script2
ae00: 20 26 0a 0a 20 20 20 20 61 66 74 65 72 20 31 30 &.. after 10
ae10: 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 00 set ok_to_pro
ae20: 63 65 65 64 20 31 0a 20 20 20 20 76 77 61 69 74 ceed 1. vwait
ae30: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a ok_to_proceed..
ae40: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
ae50: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
ae60: 20 32 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 2930]. fconf
ae70: 69 67 75 72 65 20 24 66 20 2d 62 75 66 66 65 72 igure $f -buffer
ae80: 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 ing full -blocki
ae90: 6e 67 20 30 0a 20 20 20 20 66 69 6c 65 65 76 65 ng 0. fileeve
aea0: 6e 74 20 24 66 20 72 65 61 64 61 62 6c 65 20 5b nt $f readable [
aeb0: 6c 69 73 74 20 67 65 74 64 61 74 61 20 24 66 5d list getdata $f]
aec0: 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 .. # If the s
aed0: 6f 63 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 6f ocket is still o
aee0: 70 65 6e 20 61 66 74 65 72 20 35 20 73 65 63 6f pen after 5 seco
aef0: 6e 64 73 2c 20 74 68 65 20 73 63 72 69 70 74 31 nds, the script1
af00: 20 70 72 6f 63 65 73 73 0a 20 20 20 20 23 20 6d process. # m
af10: 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 ust have inherit
af20: 65 64 20 74 68 65 20 61 63 63 65 70 74 65 64 20 ed the accepted
af30: 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 socket... set
af40: 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 failed 0. af
af50: 74 65 72 20 35 30 30 30 20 73 65 74 20 66 61 69 ter 5000 set fai
af60: 6c 65 64 20 31 0a 0a 20 20 20 20 70 72 6f 63 20 led 1.. proc
af70: 67 65 74 64 61 74 61 20 7b 20 66 69 6c 65 20 7d getdata { file }
af80: 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 61 6e 64 {...# Read hand
af90: 6c 65 72 20 6f 6e 20 74 68 65 20 63 6c 69 65 6e ler on the clien
afa0: 74 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 t socket...globa
afb0: 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c l x..global fail
afc0: 65 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b ed..set status [
afd0: 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c catch {read $fil
afe0: 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 e} data]..if {$s
aff0: 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 tatus != 0} {..
b000: 20 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 66 set x {read f
b010: 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 ailed, error was
b020: 20 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 74 $data}.. cat
b030: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
b040: 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 }..} elseif {[s
b050: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d tring compare {}
b060: 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c $data]} {..} el
b070: 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 seif {[fblocked
b080: 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 $file]} {..} els
b090: 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d eif {[eof $file]
b0a0: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 } {.. if {$fa
b0b0: 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 iled} {...set x
b0c0: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
b0d0: 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a was inherited}.
b0e0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
b0f0: 73 65 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 set x {accepted
b100: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
b110: 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d nherited}.. }
b120: 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c .. catch { cl
b130: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 ose $file }..} e
b140: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 lse {.. set x
b150: 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 {impossible cas
b160: 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 e}.. catch {
b170: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d close $file }..}
b180: 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 ..return. }.
b190: 20 20 20 0a 20 20 20 20 76 77 61 69 74 20 78 0a . vwait x.
b1a0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
b1b0: 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f script1. remo
b1c0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 veFile script2.
b1d0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 set x.} {acce
b1e0: 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 pted socket was
b1f0: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
b200: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 33 2e 31 test socket-13.1
b210: 20 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 {Testing use of
b220: 20 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 shared socket b
b230: 65 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 etween two threa
b240: 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 ds} \..{socket t
b250: 65 73 74 74 68 72 65 61 64 7d 20 7b 0a 0a 20 20 estthread} {..
b260: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
b270: 69 70 74 0a 20 20 20 20 74 68 72 65 61 64 52 65 ipt. threadRe
b280: 61 70 0a 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 ap.. makeFile
b290: 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 {. .package
b2a0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
b2b0: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
b2c0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
b2d0: 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 828]..proc accep
b2e0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 t {s a p} {.
b2f0: 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e fileeven
b300: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
b310: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
b320: 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 fconfig
b330: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
b340: 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d g line. }
b350: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
b360: 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 {.. global i
b370: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 . se
b380: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
b390: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
b3a0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
b3b0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
b3c0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
b3d0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
b3e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3f0: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
b400: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
b410: 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 .. incr
b420: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
b430: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
b440: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
b450: 0a 09 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 ..set i 0..vwait
b460: 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 x..close $f...#
b470: 20 74 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 thread cleans i
b480: 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 tself up...testt
b490: 68 72 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d hread exit. }
b4a0: 20 73 63 72 69 70 74 0a 20 20 20 20 0a 20 20 20 script. .
b4b0: 20 23 20 63 72 65 61 74 65 20 61 20 74 68 72 65 # create a thre
b4c0: 61 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 ad. set serve
b4d0: 72 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 rthread [testthr
b4e0: 65 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 ead create { sou
b4f0: 72 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 rce script } ].
b500: 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 0a 20 update. .
b510: 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 after 1000.
b520: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
b530: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
b540: 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 828]. fconfig
b550: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
b560: 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 g line.. catc
b570: 68 20 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 h {..puts $s "he
b580: 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 llo"..gets $s re
b590: 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 sult. }. c
b5a0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 lose $s. upda
b5b0: 74 65 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 te.. after 20
b5c0: 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 00. lappend r
b5d0: 65 73 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 esult [threadRea
b5e0: 70 5d 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 p]. . set
b5f0: 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f result..} {hello
b600: 20 31 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 1}..# cleanup.i
b610: 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 f {[string match
b620: 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 sock* $commandS
b630: 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 ocket] == 1} {.
b640: 20 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 puts $commandS
b650: 6f 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 6c ocket exit. fl
b660: 75 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ush $commandSock
b670: 65 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 et.}.catch {clos
b680: 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 e $commandSocket
b690: 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 }.catch {close $
b6a0: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a remoteProcChan}.
b6b0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e ::tcltest::clean
b6c0: 75 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 74 upTests.flush st
b6d0: 64 6f 75 74 0a 72 65 74 75 72 6e 0a 0a 0a 0a 0a dout.return.....
b6e0: 0a 0a 0a 0a 0a 0a 0a .......