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 39 20 32 30 30 30 2f 30 36 2f 30 33 20 30 33 .9 2000/06/03 03
0210: 3a 30 30 3a 32 32 20 61 77 62 20 45 78 70 20 24 :00:22 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: 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 61 72 .# Some tests ar
1710: 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 77 65 e run only if we
1720: 20 61 72 65 20 64 6f 69 6e 67 20 74 65 73 74 69 are doing testi
1730: 6e 67 20 61 67 61 69 6e 73 74 20 61 20 72 65 6d ng against a rem
1740: 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 65 74 20 ote server..set
1750: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 ::tcltest::testC
1760: 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 65 73 onstraints(doTes
1770: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
1780: 65 72 29 20 24 64 6f 54 65 73 74 73 57 69 74 68 er) $doTestsWith
1790: 52 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 66 20 RemoteServer.if
17a0: 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d {$doTestsWithRem
17b0: 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 30 7d 20 oteServer == 0}
17c0: 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e {. if {[strin
17d0: 67 20 66 69 72 73 74 20 73 20 24 3a 3a 74 63 6c g first s $::tcl
17e0: 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d 20 21 test::verbose] !
17f0: 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 75 74 = -1} {. .put
1800: 73 20 22 53 6b 69 70 70 69 6e 67 20 74 65 73 74 s "Skipping test
1810: 73 20 77 69 74 68 20 72 65 6d 6f 74 65 20 73 65 s with remote se
1820: 72 76 65 72 2e 20 53 65 65 20 74 65 73 74 73 2f rver. See tests/
1830: 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f 72 22 socket.test for"
1840: 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 6d 61 74 ..puts "informat
1850: 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 72 75 ion on how to ru
1860: 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e n remote server.
1870: 22 0a 09 70 75 74 73 20 22 52 65 61 73 6f 6e 20 "..puts "Reason
1880: 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 72 65 for not doing re
1890: 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 6e 6f 52 mote tests: $noR
18a0: 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 22 emoteTestReason"
18b0: 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 . }.}..#.# If
18c0: 20 77 65 20 64 6f 20 74 68 65 20 74 65 73 74 73 we do the tests
18d0: 2c 20 64 65 66 69 6e 65 20 61 20 63 6f 6d 6d 61 , define a comma
18e0: 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 63 6f 6d nd to send a com
18f0: 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 72 65 mand to the.# re
1900: 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 0a 0a mote server..#..
1910: 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 if {$doTestsWith
1920: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 RemoteServer ==
1930: 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 73 65 1} {. proc se
1940: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a ndCommand {c} {.
1950: 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 .global commandS
1960: 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 ocket...if {[eof
1970: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
1980: 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 } {.. error "
1990: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 remote server di
19a0: 73 61 70 70 65 61 72 65 64 22 0a 09 7d 0a 0a 09 sappeared"..}...
19b0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 if {[catch {puts
19c0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
19d0: 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 $c} msg]} {..
19e0: 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 error "remote s
19f0: 65 72 76 65 72 20 64 69 73 61 70 70 61 65 72 65 erver disappaere
1a00: 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 66 20 d: $msg"..}..if
1a10: 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 {[catch {puts $c
1a20: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 2d 2d ommandSocket "--
1a30: 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d Marker--Marker--
1a40: 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d Marker--"} msg]}
1a50: 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 {.. error "r
1a60: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 emote server dis
1a70: 61 70 70 65 61 72 65 64 3a 20 24 6d 73 67 22 0a appeared: $msg".
1a80: 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 22 22 .}...set resp ""
1a90: 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 ..while {1} {..
1aa0: 20 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 65 74 set line [get
1ab0: 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 s $commandSocket
1ac0: 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 ].. if {[eof
1ad0: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d $commandSocket]}
1ae0: 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 6d 6f {...error "remo
1af0: 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 te server disapp
1b00: 65 61 72 65 64 22 0a 09 20 20 20 20 7d 0a 09 20 eared".. }..
1b10: 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 if {[string c
1b20: 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 2d 2d ompare $line "--
1b30: 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d Marker--Marker--
1b40: 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d Marker--"] == 0}
1b50: 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 {...if {[string
1b60: 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 compare [lindex
1b70: 20 24 72 65 73 70 20 30 5d 20 65 72 72 6f 72 5d $resp 0] error]
1b80: 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 65 == 0} {... e
1b90: 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 72 65 rror [lindex $re
1ba0: 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 20 7b sp 1]...} else {
1bb0: 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 5b 6c ... return [l
1bc0: 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 index $resp 1]..
1bd0: 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b .}.. } else {
1be0: 0a 09 09 61 70 70 65 6e 64 20 72 65 73 70 20 24 ...append resp $
1bf0: 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 20 7d line "\n".. }
1c00: 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 73 ..}. }.}..tes
1c10: 74 20 73 6f 63 6b 65 74 2d 31 2e 31 20 7b 61 72 t socket-1.1 {ar
1c20: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1c30: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1c40: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1c50: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1c60: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 6d ocket -server} m
1c70: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
1c80: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
1c90: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
1ca0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
1cb0: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
1cc0: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b rt"}}..test sock
1cd0: 65 74 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 et-1.2 {arg pars
1ce0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
1cf0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
1d00: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
1d10: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
1d20: 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 -server foo} msg
1d30: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
1d40: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
1d50: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
1d60: 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e t -server comman
1d70: 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 d ?options? port
1d80: 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 "}}..test socket
1d90: 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e -1.3 {arg parsin
1da0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
1db0: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
1dc0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
1dd0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
1de0: 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 yaddr} msg] $msg
1df0: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
1e00: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
1e10: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
1e20: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
1e30: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
1e40: 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.4 {arg parsing
1e50: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
1e60: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
1e70: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
1e80: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
1e90: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 addr 127.0.0.1}
1ea0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
1eb0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
1ec0: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
1ed0: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
1ee0: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
1ef0: 74 20 73 6f 63 6b 65 74 2d 31 2e 35 20 7b 61 72 t socket-1.5 {ar
1f00: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1f10: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1f20: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1f30: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1f40: 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d ocket -myport} m
1f50: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
1f60: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
1f70: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
1f80: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
1f90: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
1fa0: 20 73 6f 63 6b 65 74 2d 31 2e 36 20 7b 61 72 67 socket-1.6 {arg
1fb0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
1fc0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
1fd0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
1fe0: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
1ff0: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 cket -myport xxx
2000: 78 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b x} msg] $msg.} {
2010: 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 1 {wrong # args:
2020: 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a should be "tls:
2030: 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 :socket ?options
2040: 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a ? host port"}}..
2050: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 2e 37 20 test socket-1.7
2060: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2070: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2080: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2090: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
20a0: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 ::socket -myport
20b0: 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 2522} msg] $msg
20c0: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
20d0: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
20e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
20f0: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
2100: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
2110: 31 2e 38 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.8 {arg parsing
2120: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2130: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2140: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2150: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 {tls::socket -fr
2160: 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a oboz} msg] $msg.
2170: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2180: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2190: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
21a0: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
21b0: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 }..test socket-1
21c0: 2e 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .9 {arg parsing
21d0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
21e0: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
21f0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
2200: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
2210: 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f 72 74 20 ver foo -myport
2220: 32 35 32 31 20 33 33 33 33 7d 20 6d 73 67 5d 20 2521 3333} msg]
2230: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
2240: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
2250: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
2260: 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 -server command
2270: 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d ?options? port"}
2280: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 }..test socket-1
2290: 2e 31 30 20 7b 61 72 67 20 70 61 72 73 69 6e 67 .10 {arg parsing
22a0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
22b0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
22c0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
22d0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 {tls::socket hos
22e0: 74 20 32 35 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 t 2528 -junk} ms
22f0: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2300: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2310: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2320: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
2330: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
2340: 73 6f 63 6b 65 74 2d 31 2e 31 31 20 7b 61 72 67 socket-1.11 {arg
2350: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2360: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2370: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2380: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2390: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 61 6c cket -server cal
23a0: 6c 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d 20 6d lback 2520 --} m
23b0: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
23c0: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
23d0: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
23e0: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
23f0: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
2400: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b rt"}}..test sock
2410: 65 74 2d 31 2e 31 32 20 7b 61 72 67 20 70 61 72 et-1.12 {arg par
2420: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2430: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2440: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2450: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2460: 20 66 6f 6f 20 62 61 64 70 6f 72 74 7d 20 6d 73 foo badport} ms
2470: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 65 78 g] $msg.} {1 {ex
2480: 70 65 63 74 65 64 20 69 6e 74 65 67 65 72 20 62 pected integer b
2490: 75 74 20 67 6f 74 20 22 62 61 64 70 6f 72 74 22 ut got "badport"
24a0: 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d }}..test socket-
24b0: 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.1 {tcp connect
24c0: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ion} {socket std
24d0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
24e0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
24f0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
2500: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
2510: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
2520: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
2530: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
2540: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
2550: 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 20 20 _out"]. }.
2560: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2570: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2580: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
2590: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
25a0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
25b0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
25c0: 76 65 72 4b 65 79 20 32 38 32 38 20 5c 5d 22 0a verKey 2828 \]".
25d0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
25e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
25f0: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 addr port} {..
2600: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
2610: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
2620: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
2630: 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 ile..}..puts rea
2640: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
2650: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
2660: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
2670: 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $x. }. cl
2680: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
2690: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
26a0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
26b0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
26c0: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
26d0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
26e0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
26f0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
2700: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
2710: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
2720: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
2730: 32 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 2828} msg]} {.
2740: 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 set x $msg
2750: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
2760: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
2770: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
2780: 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 close $msg.
2790: 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 }. lappend x
27a0: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
27b0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
27c0: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 x.} {ready done
27d0: 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 78 {}}..if [info ex
27e0: 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 20 ists port] {.
27f0: 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c 73 incr port.} els
2800: 65 20 7b 20 0a 20 20 20 20 73 65 74 20 70 6f 72 e { . set por
2810: 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b 20 5b t [expr 2048 + [
2820: 70 69 64 5d 25 31 30 32 34 5d 0a 7d 0a 0a 74 65 pid]%1024].}..te
2830: 73 74 20 73 6f 63 6b 65 74 2d 32 2e 32 20 7b 74 st socket-2.2 {t
2840: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 cp connection wi
2850: 74 68 20 63 6c 69 65 6e 74 20 70 6f 72 74 20 73 th client port s
2860: 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 pecified} {socke
2870: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
2880: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
2890: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
28a0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
28b0: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
28c0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
28d0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
28e0: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
28f0: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
2900: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
2910: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2920: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
2930: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
2940: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
2950: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
2960: 65 79 20 32 38 32 39 20 5c 5d 22 0a 20 20 20 20 ey 2829 \]".
2970: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
2980: 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 accept {file add
2990: 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 r port} {.
29a0: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
29b0: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
29c0: 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 20 24 70 "[gets $file] $p
29d0: 6f 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 ort".
29e0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 close $file.
29f0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
2a00: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
2a10: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
2a20: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
2a30: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
2a40: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
2a50: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
2a60: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
2a70: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
2a80: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
2a90: 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 f x. global p
2aa0: 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 ort. if {[cat
2ab0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2ac0: 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a -myport $port \.
2ad0: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
2ae0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
2af0: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
2b00: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
2b10: 37 2e 30 2e 30 2e 31 20 32 38 32 39 7d 20 73 6f 7.0.0.1 2829} so
2b20: 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 ck]} {. s
2b30: 65 74 20 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 et x $sock..catc
2b40: 68 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 h {close [tls::s
2b50: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
2b60: 32 38 32 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 2829]}. } els
2b70: 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 e {. puts
2b80: 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c $sock hello..fl
2b90: 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 ush $sock.
2ba0: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
2bb0: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
2bc0: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
2bd0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
2be0: 20 73 65 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 set x.} [list r
2bf0: 65 61 64 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 eady "hello $por
2c00: 74 22 5d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 t"]..test socket
2c10: 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.3 {tcp connec
2c20: 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 tion with client
2c30: 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 interface speci
2c40: 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 fied} {socket st
2c50: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
2c60: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
2c70: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
2c80: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
2c90: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
2ca0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
2cb0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
2cc0: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 "set x done"].
2cd0: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
2ce0: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
2cf0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
2d00: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
2d10: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
2d20: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
2d30: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 ile $serverKey 2
2d40: 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 830 \]". puts
2d50: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
2d60: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
2d70: 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 rt} {.
2d80: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
2d90: 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 puts "[ge
2da0: 74 73 20 24 66 69 6c 65 5d 20 24 61 64 64 72 22 ts $file] $addr"
2db0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
2dc0: 73 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 se $file.
2dd0: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
2de0: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
2df0: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
2e00: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
2e10: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
2e20: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
2e30: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
2e40: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
2e50: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
2e60: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
2e70: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
2e80: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 tls::socket -mya
2e90: 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 5c 0a ddr 127.0.0.1 \.
2ea0: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
2eb0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
2ec0: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
2ed0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
2ee0: 37 2e 30 2e 30 2e 31 20 32 38 33 30 7d 20 73 6f 7.0.0.1 2830} so
2ef0: 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 ck]} {. s
2f00: 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d et x $sock. }
2f10: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
2f20: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
2f30: 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 20 24 ..catch {flush $
2f40: 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 6c 61 sock}. la
2f50: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
2f60: 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 ]. close
2f70: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
2f80: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2f90: 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 6c x.} {ready {hel
2fa0: 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a 0a lo 127.0.0.1}}..
2fb0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 34 20 test socket-2.4
2fc0: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 {tcp connection
2fd0: 77 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 65 with server inte
2fe0: 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 7d rface specified}
2ff0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
3000: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
3010: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
3020: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
3030: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
3040: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
3050: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
3060: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
3070: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
3080: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
3090: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
30a0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
30b0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
30c0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
30d0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
30e0: 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 serverKey -myadd
30f0: 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 r [info hostname
3100: 5d 20 32 38 33 31 20 5c 5d 22 0a 20 20 20 20 70 ] 2831 \]". p
3110: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
3120: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
3130: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
3140: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
3150: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
3160: 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 [gets $file]".
3170: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
3180: 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 $file.
3190: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a set x done..}.
31a0: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
31b0: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
31c0: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
31d0: 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $f. }. cl
31e0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
31f0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
3200: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
3210: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
3220: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
3230: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
3240: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
3250: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
3260: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
3270: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
3280: 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 ntKey [info host
3290: 6e 61 6d 65 5d 20 32 38 33 31 7d 20 73 6f 63 6b name] 2831} sock
32a0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
32b0: 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 x $sock. } e
32c0: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 lse {. pu
32d0: 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 ts $sock hello..
32e0: 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 flush $sock.
32f0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
3300: 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 ets $f].
3310: 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 close $sock.
3320: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
3330: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
3340: 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 73 y hello}..test s
3350: 6f 63 6b 65 74 2d 32 2e 35 20 7b 74 63 70 20 63 ocket-2.5 {tcp c
3360: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 72 onnection with r
3370: 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 20 edundant server
3380: 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 port} {socket st
3390: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
33a0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
33b0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
33c0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
33d0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
33e0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
33f0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
3400: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 "set x done"].
3410: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
3420: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
3430: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
3440: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
3450: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
3460: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
3470: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 ile $serverKey 2
3480: 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 832 \]". puts
3490: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
34a0: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
34b0: 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 rt} {.
34c0: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
34d0: 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 puts "[ge
34e0: 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 20 20 20 ts $file]".
34f0: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 close $fi
3500: 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 le. s
3510: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
3520: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
3530: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
3540: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
3550: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
3560: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
3570: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
3580: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
3590: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
35a0: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
35b0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
35c0: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
35d0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
35e0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
35f0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
3600: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 ey 127.0.0.1 283
3610: 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 2} sock]} {.
3620: 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a set x $sock.
3630: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
3640: 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 puts $sock
3650: 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f hello..flush $so
3660: 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 ck. lappe
3670: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
3680: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f close $so
3690: 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f ck. }. clo
36a0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
36b0: 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d 0a } {ready hello}.
36c0: 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 36 20 test socket-2.6
36d0: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d {tcp connection}
36e0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
36f0: 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 set status ok.
3700: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 if {![catch {s
3710: 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f et sock [tls::so
3720: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
3730: 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 833]}]} {..if {!
3740: 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 6f [catch {gets $so
3750: 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 ck}]} {.. set
3760: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
3770: 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 }..close $sock.
3780: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 }. set sta
3790: 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 73 tus.} ok..test s
37a0: 6f 63 6b 65 74 2d 32 2e 37 20 7b 65 63 68 6f 20 ocket-2.7 {echo
37b0: 73 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 server, one line
37c0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
37d0: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
37e0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
37f0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3800: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
3810: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
3820: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
3830: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
3840: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
3850: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
3860: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
3870: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3880: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
3890: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
38a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
38b0: 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 34 20 $serverKey 2834
38c0: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
38d0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
38e0: 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 s a p} {.
38f0: 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 fileevent $
3900: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
3910: 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 echo $s].. f
3920: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
3930: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 anslation lf -bu
3940: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
3950: 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 }..proc ech
3960: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 o {s} {.. se
3970: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
3980: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
3990: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
39a0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
39b0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
39c0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
39d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39e0: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
39f0: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
3a00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3a10: 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 puts $s $l.
3a20: 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 }..}..
3a30: 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 puts ready..vwai
3a40: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
3a50: 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 l $timer..close
3a60: 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 $f..puts done.
3a70: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
3a80: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
3a90: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
3aa0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
3ab0: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
3ac0: 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b s $f. set s [
3ad0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
3ae0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
3af0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3b00: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
3b10: 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 lientKey 127.0.0
3b20: 2e 31 20 32 38 33 34 5d 0a 20 20 20 20 66 63 6f .1 2834]. fco
3b30: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
3b40: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
3b50: 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 slation lf. p
3b60: 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 uts $s "hello ab
3b70: 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a cdefghijklmnop".
3b80: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 after 1000.
3b90: 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 set x [gets $
3ba0: 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a s]. close $s.
3bb0: 20 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 20 set y [gets
3bc0: 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 $f]. close $f
3bd0: 0a 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 0a . list $x $y.
3be0: 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 } {{hello abcdef
3bf0: 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 ghijklmnop} done
3c00: 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 }..test socket-2
3c10: 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c .8 {echo server,
3c20: 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 loop 50 times,
3c30: 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f single connectio
3c40: 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f n} {socket stdio
3c50: 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 20 5b 6f } {. set f [o
3c60: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
3c70: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
3c80: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
3c90: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
3ca0: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3cb0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3cc0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
3cd0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
3ce0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3cf0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
3d00: 72 4b 65 79 20 32 38 33 35 20 5c 5d 22 0a 20 20 rKey 2835 \]".
3d10: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
3d20: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
3d30: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 {. f
3d40: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
3d50: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
3d60: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
3d70: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
3d80: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
3d90: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
3da0: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 ho {s} {.. g
3db0: 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 lobal i.
3dc0: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
3dd0: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
3de0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
3df0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
3e00: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
3e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
3e20: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
3e30: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
3e40: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
3e50: 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 else { ..
3e60: 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 incr i.
3e70: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
3e80: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
3e90: 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 }..}..set i 0
3ea0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
3eb0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
3ec0: 30 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 0000 "set x done
3ed0: 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 "]..vwait x..aft
3ee0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3ef0: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
3f00: 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d "done $i". }
3f10: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3f20: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3f30: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3f40: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3f50: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
3f60: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
3f70: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
3f80: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
3f90: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
3fa0: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
3fb0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
3fc0: 32 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2835]. fconfi
3fd0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
3fe0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 ng line. catc
3ff0: 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 h {..for {set x
4000: 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 0} {$x < 50} {in
4010: 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 cr x} {.. put
4020: 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 s $s "hello abcd
4030: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 efghijklmnop"..
4040: 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 gets $s..}.
4050: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
4060: 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 . catch {set
4070: 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 x [gets $f]}.
4080: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4090: 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a t x.} {done 50}.
40a0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 32 2e 39 .test socket-2.9
40b0: 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 {socket conflic
40c0: 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f t} {socket stdio
40d0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 } {. set s [t
40e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
40f0: 65 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a er accept 2828].
4100: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
4110: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
4120: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
4130: 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c puts -nonewl
4140: 69 6e 65 20 24 66 20 7b 70 61 63 6b 61 67 65 20 ine $f {package
4150: 72 65 71 75 69 72 65 20 74 6c 73 3b 20 74 6c 73 require tls; tls
4160: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4170: 20 61 63 63 65 70 74 20 32 38 32 38 7d 0a 20 20 accept 2828}.
4180: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
4190: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
41a0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
41b0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
41c0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
41d0: 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 20 20 after 100.
41e0: 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 set x [list [ca
41f0: 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d tch {close $f} m
4200: 73 67 5d 20 24 6d 73 67 5d 0a 20 20 20 20 63 6c sg] $msg]. cl
4210: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 78 ose $s. set x
4220: 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 .} {1 {couldn't
4230: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 open socket: add
4240: 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 ress already in
4250: 75 73 65 0a 20 20 20 20 77 68 69 6c 65 20 65 78 use. while ex
4260: 65 63 75 74 69 6e 67 0a 22 3a 3a 73 6f 63 6b 65 ecuting."::socke
4270: 74 20 2d 73 65 72 76 65 72 20 7b 74 6c 73 3a 3a t -server {tls::
4280: 5f 61 63 63 65 70 74 20 7b 2d 73 65 72 76 65 72 _accept {-server
4290: 20 31 7d 20 61 63 63 65 70 74 7d 20 32 38 32 38 1} accept} 2828
42a0: 22 0a 20 20 20 20 28 22 65 76 61 6c 22 20 62 6f ". ("eval" bo
42b0: 64 79 20 6c 69 6e 65 20 31 29 0a 20 20 20 20 69 dy line 1). i
42c0: 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 74 68 nvoked from with
42d0: 69 6e 0a 22 65 76 61 6c 20 3a 3a 73 6f 63 6b 65 in."eval ::socke
42e0: 74 20 24 73 6f 70 74 73 22 0a 20 20 20 20 28 70 t $sopts". (p
42f0: 72 6f 63 65 64 75 72 65 20 22 74 6c 73 3a 3a 73 rocedure "tls::s
4300: 6f 63 6b 65 74 22 20 6c 69 6e 65 20 36 32 29 0a ocket" line 62).
4310: 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 72 6f 6d invoked from
4320: 20 77 69 74 68 69 6e 0a 22 74 6c 73 3a 3a 73 6f within."tls::so
4330: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4340: 65 70 74 20 32 38 32 38 22 0a 20 20 20 20 28 66 ept 2828". (f
4350: 69 6c 65 20 22 73 63 72 69 70 74 22 20 6c 69 6e ile "script" lin
4360: 65 20 31 29 7d 7d 0a 0a 74 65 73 74 20 73 6f 63 e 1)}}..test soc
4370: 6b 65 74 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 20 ket-2.10 {close
4380: 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 70 on accept, accep
4390: 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 73 ted socket lives
43a0: 7d 20 7b 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 } {socket knownB
43b0: 75 67 7d 20 7b 0a 20 20 20 20 73 65 74 20 64 6f ug} {. set do
43c0: 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 69 6d ne 0. set tim
43d0: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 er [after 20000
43e0: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
43f0: 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 73 out"]. set ss
4400: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
4410: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
4420: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
4430: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4440: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4450: 73 65 72 76 65 72 4b 65 79 20 32 38 33 30 5d 0a serverKey 2830].
4460: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
4470: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
4480: 6c 20 73 73 0a 09 63 6c 6f 73 65 20 24 73 73 0a l ss..close $ss.
4490: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
44a0: 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 adable "readit $
44b0: 73 22 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 s"..fconfigure $
44c0: 73 20 2d 74 72 61 6e 73 20 6c 66 0a 20 20 20 20 s -trans lf.
44d0: 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 }. proc readi
44e0: 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 t {s} {..global
44f0: 64 6f 6e 65 0a 09 67 65 74 73 20 24 73 0a 09 63 done..gets $s..c
4500: 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 64 6f 6e lose $s..set don
4510: 65 20 31 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 e 1. }. se
4520: 74 20 63 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t cs [tls::socke
4530: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
4540: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
4550: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
4560: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5b ile $clientKey [
4570: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 info hostname] 2
4580: 38 33 30 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 830]. close $
4590: 63 73 0a 0a 20 20 20 20 76 77 61 69 74 20 64 6f cs.. vwait do
45a0: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
45b0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 cel $timer. s
45c0: 65 74 20 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 et done.} 1..tes
45d0: 74 20 73 6f 63 6b 65 74 2d 32 2e 31 31 20 7b 64 t socket-2.11 {d
45e0: 65 74 65 63 74 69 6e 67 20 6e 65 77 20 64 61 74 etecting new dat
45f0: 61 7d 20 7b 73 6f 63 6b 65 74 20 6b 6e 6f 77 6e a} {socket known
4600: 42 75 67 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 Bug} {. proc
4610: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
4620: 0a 09 67 6c 6f 62 61 6c 20 73 6f 63 6b 0a 09 73 ..global sock..s
4630: 65 74 20 73 6f 63 6b 20 24 73 0a 09 73 65 74 20 et sock $s..set
4640: 66 20 5b 6f 70 65 6e 20 61 77 62 2e 6c 6f 67 20 f [open awb.log
4650: 77 5d 0a 09 70 75 74 73 20 24 66 20 5b 63 61 74 w]..puts $f [cat
4660: 63 68 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 ch {tls::handsha
4670: 6b 65 20 24 73 6f 63 6b 7d 20 65 72 72 5d 0a 09 ke $sock} err]..
4680: 70 75 74 73 20 24 66 20 22 65 72 72 3a 20 24 65 puts $f "err: $e
4690: 72 72 22 0a 09 70 75 74 73 20 24 66 20 22 5b 74 rr"..puts $f "[t
46a0: 6c 73 3a 3a 73 74 61 74 75 73 20 24 73 6f 63 6b ls::status $sock
46b0: 5d 22 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 ]"..close $s.
46c0: 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }.. set s [t
46d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 72 65 71 75 ls::socket -requ
46e0: 69 72 65 20 30 20 2d 72 65 71 75 65 73 74 20 30 ire 0 -request 0
46f0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4700: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
4710: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
4720: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
4730: 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 34 30 e $serverKey 240
4740: 30 5d 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 20 0]. set sock
4750: 22 22 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 "". set s2 [t
4760: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
4770: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
4780: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4790: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
47a0: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
47b0: 31 20 32 34 30 30 5d 0a 20 20 20 20 76 77 61 69 1 2400]. vwai
47c0: 74 20 73 6f 63 6b 0a 20 20 20 20 70 75 74 73 20 t sock. puts
47d0: 24 73 32 20 6f 6e 65 0a 20 20 20 20 66 6c 75 73 $s2 one. flus
47e0: 68 20 24 73 32 0a 20 20 20 20 61 66 74 65 72 20 h $s2. after
47f0: 35 30 30 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 500. fconfigu
4800: 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 re $sock -blocki
4810: 6e 67 20 30 0a 20 20 20 20 73 65 74 20 72 65 73 ng 0. set res
4820: 75 6c 74 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d ult [gets $sock]
4830: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 . lappend res
4840: 75 6c 74 20 5b 67 65 74 73 20 24 73 6f 63 6b 5d ult [gets $sock]
4850: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4860: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
4870: 31 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 74 1. puts $s2 t
4880: 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 wo. flush $s2
4890: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
48a0: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
48b0: 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 0. lappend re
48c0: 73 75 6c 74 20 5b 67 65 74 73 20 24 73 6f 63 6b sult [gets $sock
48d0: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
48e0: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
48f0: 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 1. close $s2
4900: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
4910: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
4920: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 7b set result.} {
4930: 6f 6e 65 20 7b 7d 20 74 77 6f 7d 0a 0a 74 65 73 one {} two}..tes
4940: 74 20 73 6f 63 6b 65 74 2d 32 2e 31 32 20 7b 74 t socket-2.12 {t
4950: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b 20 6e cp connection; n
4960: 6f 20 63 65 72 74 69 66 69 63 61 74 65 73 20 73 o certificates s
4970: 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 pecified} {socke
4980: 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d t stdio pcCrash}
4990: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
49a0: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
49b0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
49c0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
49d0: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
49e0: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
49f0: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
4a00: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
4a10: 74 22 5d 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a t"]..set f [tls:
4a20: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4a30: 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 70 72 accept 2828]..pr
4a40: 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 oc accept {file
4a50: 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 addr port} {..
4a60: 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 global x..
4a70: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
4a80: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 close $fi
4a90: 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 le..}..puts read
4aa0: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
4ab0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
4ac0: 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 .close $f..puts
4ad0: 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $x. }. clo
4ae0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
4af0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
4b00: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
4b10: 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 t script]" r].
4b20: 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 gets $f x.
4b30: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
4b40: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
4b50: 31 20 32 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 1 2828} msg]} {.
4b60: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 24 6d set x $m
4b70: 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a sg. } else {.
4b80: 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 lappend
4b90: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
4ba0: 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 close $msg.
4bb0: 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 }. lappend
4bc0: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
4bd0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4be0: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e t x.} {ready don
4bf0: 65 20 7b 7d 7d 0a 0a 0a 0a 0a 74 65 73 74 20 73 e {}}.....test s
4c00: 6f 63 6b 65 74 2d 33 2e 31 20 7b 73 6f 63 6b 65 ocket-3.1 {socke
4c10: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 t conflict} {soc
4c20: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
4c30: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
4c40: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
4c50: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
4c60: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
4c70: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
4c80: 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a tls..set f [tls:
4c90: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
4ca0: 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 70 75 accept 2828]..pu
4cb0: 74 73 20 72 65 61 64 79 0a 09 67 65 74 73 20 73 ts ready..gets s
4cc0: 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a 20 tdin..close $f.
4cd0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
4ce0: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
4cf0: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
4d00: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
4d10: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 67 ript]" r+]. g
4d20: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 78 ets $f. set x
4d30: 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 [list [catch {t
4d40: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4d50: 65 72 20 61 63 63 65 70 74 20 32 38 32 38 7d 20 er accept 2828}
4d60: 6d 73 67 5d 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 msg] \...$msg].
4d70: 20 20 20 70 75 74 73 20 24 66 20 62 79 65 0a 20 puts $f bye.
4d80: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
4d90: 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c set x.} {1 {coul
4da0: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
4db0: 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 : address alread
4dc0: 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 y in use}}..test
4dd0: 20 73 6f 63 6b 65 74 2d 33 2e 32 20 7b 73 65 72 socket-3.2 {ser
4de0: 76 65 72 20 77 69 74 68 20 73 65 76 65 72 61 6c ver with several
4df0: 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 clients} {socke
4e00: 74 20 73 74 64 69 6f 20 70 63 43 72 61 73 68 7d t stdio pcCrash}
4e10: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
4e20: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
4e30: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
4e40: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
4e50: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
4e60: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
4e70: 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 1 [after 30000 "
4e80: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
4e90: 5d 0a 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 ]..set t2 [after
4ea0: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
4eb0: 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 med_out"]..set t
4ec0: 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 3 [after 32000 "
4ed0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
4ee0: 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 ]..set counter 0
4ef0: 0a 09 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f ..set s [tls::so
4f00: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4f10: 65 70 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 ept 2828]..proc
4f20: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
4f30: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
4f40: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
4f50: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
4f60: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
4f70: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 7d uffering line..}
4f80: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
4f90: 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 {.. global x
4fa0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 . se
4fb0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
4fc0: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
4fd0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
4fe0: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
4ff0: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
5000: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
5010: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 . }
5020: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 else {.
5030: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
5040: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
5050: 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 }..}..puts ready
5060: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
5070: 20 63 61 6e 63 65 6c 20 24 74 31 0a 09 76 77 61 cancel $t1..vwa
5080: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
5090: 65 6c 20 24 74 32 0a 09 76 77 61 69 74 20 78 0a el $t2..vwait x.
50a0: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
50b0: 33 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 3..close $s..put
50c0: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
50d0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
50e0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
50f0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
5100: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
5110: 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 . set x [gets
5120: 20 24 66 5d 0a 20 20 20 20 73 65 74 20 73 31 20 $f]. set s1
5130: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
5140: 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 .0.0.1 2828].
5150: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 20 fconfigure $s1
5160: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
5170: 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a set s2 [tls:
5180: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
5190: 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 2828]. fcon
51a0: 66 69 67 75 72 65 20 24 73 32 20 2d 62 75 66 66 figure $s2 -buff
51b0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
51c0: 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s3 [tls::sock
51d0: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 et 127.0.0.1 282
51e0: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
51f0: 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 e $s3 -buffering
5200: 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 line. for {s
5210: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 et i 0} {$i < 10
5220: 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 0} {incr i} {..p
5230: 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 uts $s1 hello,s1
5240: 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 ..gets $s1..puts
5250: 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 $s2 hello,s2..g
5260: 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 ets $s2..puts $s
5270: 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 3 hello,s3..gets
5280: 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 $s3. }. c
5290: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f lose $s1. clo
52a0: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
52b0: 20 24 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 $s3. lappend
52c0: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
52d0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
52e0: 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e t x.} {ready don
52f0: 65 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d e}..test socket-
5300: 34 2e 31 20 7b 73 65 72 76 65 72 20 77 69 74 68 4.1 {server with
5310: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
5320: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 } {socket stdio
5330: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 pcCrash} {. r
5340: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
5350: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5360: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
5370: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
5380: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
5390: 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 73 s..gets stdin..s
53a0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
53b0: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 t 127.0.0.1 2828
53c0: 5d 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 ]..fconfigure $s
53d0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
53e0: 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 ..for {set i 0}
53f0: 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 {$i < 100} {incr
5400: 20 69 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 i} {.. puts
5410: 24 73 20 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 $s hello.. ge
5420: 74 73 20 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 ts $s..}..close
5430: 24 73 0a 09 70 75 74 73 20 62 79 65 0a 09 67 65 $s..puts bye..ge
5440: 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 ts stdin. }.
5450: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5460: 73 65 74 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b set p1 [open "|[
5470: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5480: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5490: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
54a0: 67 75 72 65 20 24 70 31 20 2d 62 75 66 66 65 72 gure $p1 -buffer
54b0: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
54c0: 20 70 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 p2 [open "|[lis
54d0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
54e0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
54f0: 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 +]. fconfigur
5500: 65 20 24 70 32 20 2d 62 75 66 66 65 72 69 6e 67 e $p2 -buffering
5510: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 33 line. set p3
5520: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5530: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5540: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5550: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
5560: 70 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p3 -buffering li
5570: 6e 65 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 ne. proc acce
5580: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
5590: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
55a0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c fering line..fil
55b0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
55c0: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
55d0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 ]. }. proc
55e0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f echo {s} {..glo
55f0: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 73 65 bal x. se
5600: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
5610: 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 if {[eof $
5620: 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 s]} {.
5630: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
5640: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
5650: 65 0a 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 e. } else
5660: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 {. p
5670: 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 uts $s $l.
5680: 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 }. }. se
5690: 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 t t1 [after 3000
56a0: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
56b0: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 32 20 ut"]. set t2
56c0: 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 73 65 [after 31000 "se
56d0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
56e0: 20 20 20 20 73 65 74 20 74 33 20 5b 61 66 74 65 set t3 [afte
56f0: 72 20 33 32 30 30 30 20 22 73 65 74 20 78 20 74 r 32000 "set x t
5700: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
5710: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
5720: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
5730: 20 32 38 32 38 5d 0a 20 20 20 20 70 75 74 73 20 2828]. puts
5740: 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 $p1 open. put
5750: 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 s $p2 open. p
5760: 75 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 uts $p3 open.
5770: 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 vwait x. vwa
5780: 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 it x. vwait x
5790: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
57a0: 6c 20 24 74 31 0a 20 20 20 20 61 66 74 65 72 20 l $t1. after
57b0: 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 61 cancel $t2. a
57c0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a fter cancel $t3.
57d0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
57e0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
57f0: 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 ppend l [list p1
5800: 20 5b 67 65 74 73 20 24 70 31 5d 20 24 78 5d 0a [gets $p1] $x].
5810: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
5820: 69 73 74 20 70 32 20 5b 67 65 74 73 20 24 70 32 ist p2 [gets $p2
5830: 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e ] $x]. lappen
5840: 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 d l [list p3 [ge
5850: 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 ts $p3] $x].
5860: 70 75 74 73 20 24 70 31 20 62 79 65 0a 20 20 20 puts $p1 bye.
5870: 20 70 75 74 73 20 24 70 32 20 62 79 65 0a 20 20 puts $p2 bye.
5880: 20 20 70 75 74 73 20 24 70 33 20 62 79 65 0a 20 puts $p3 bye.
5890: 20 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 close $p1.
58a0: 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 63 close $p2. c
58b0: 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 73 65 74 lose $p3. set
58c0: 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 6f l.} {{p1 bye do
58d0: 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e 65 ne} {p2 bye done
58e0: 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d 7d } {p3 bye done}}
58f0: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 34 2e ..test socket-4.
5900: 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 2 {byte order pr
5910: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
5920: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b umbers, htons} {
5930: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
5940: 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b t x ok. if {[
5950: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
5960: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
5970: 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 0x3000} msg]} {.
5980: 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 .set x $msg.
5990: 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 } else {..close
59a0: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
59b0: 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 et x.} ok..test
59c0: 73 6f 63 6b 65 74 2d 35 2e 31 20 7b 62 79 74 65 socket-5.1 {byte
59d0: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
59e0: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
59f0: 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b htons} \..{sock
5a00: 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 et unixOnly notR
5a10: 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 oot} {. set x
5a20: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
5a30: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
5a40: 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 r}. if {![cat
5a50: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
5a60: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 -server dodo 0x1
5a70: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
5a80: 20 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 set x {htons p
5a90: 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 roblem, should b
5aa0: 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 e disallowed, ar
5ab0: 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 e you running as
5ac0: 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 SU?}..close $ms
5ad0: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
5ae0: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
5af0: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
5b00: 77 6e 65 72 7d 0a 74 65 73 74 20 73 6f 63 6b 65 wner}.test socke
5b10: 74 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 t-5.2 {byte orde
5b20: 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b r problems, sock
5b30: 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e et numbers, hton
5b40: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
5b50: 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 set x {couldn'
5b60: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
5b70: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
5b80: 69 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 igh}. if {![c
5b90: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
5ba0: 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 t -server dodo 0
5bb0: 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a x10000} msg]} {.
5bc0: 09 73 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 .set x {port res
5bd0: 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c olution problem,
5be0: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
5bf0: 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d lowed}..close $m
5c00: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
5c10: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
5c20: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 pen socket: port
5c30: 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 number too high
5c40: 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 35 2e }.test socket-5.
5c50: 33 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 3 {byte order pr
5c60: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
5c70: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c umbers, htons} \
5c80: 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e ..{socket unixOn
5c90: 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 ly notRoot} {.
5ca0: 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 set x {couldn'
5cb0: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e t open socket: n
5cc0: 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 ot owner}. if
5cd0: 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a {![catch {tls::
5ce0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 socket -server d
5cf0: 6f 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a odo 21} msg]} {.
5d00: 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 .set x {htons pr
5d10: 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 oblem, should be
5d20: 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 disallowed, are
5d30: 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 you running as
5d40: 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 SU?}..close $msg
5d50: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
5d60: 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 .} {couldn't ope
5d70: 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 n socket: not ow
5d80: 6e 65 72 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 ner}..test socke
5d90: 74 2d 36 2e 31 20 7b 61 63 63 65 70 74 20 63 61 t-6.1 {accept ca
5da0: 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 llback error} {s
5db0: 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 ocket stdio pcCr
5dc0: 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ash} {. remov
5dd0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
5de0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
5df0: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
5e00: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
5e10: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 e require tls..g
5e20: 65 74 73 20 73 74 64 69 6e 0a 09 74 6c 73 3a 3a ets stdin..tls::
5e30: 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 socket 127.0.0.1
5e40: 20 32 38 34 38 0a 20 20 20 20 7d 0a 20 20 20 20 2848. }.
5e50: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5e60: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
5e70: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
5e80: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b test script]" r+
5e90: 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 ]. proc bgerr
5ea0: 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 or args {..globa
5eb0: 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 l x..set x $args
5ec0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
5ed0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
5ee0: 65 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 expr 10 / 0}.
5ef0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
5f00: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
5f10: 70 74 20 32 38 34 38 5d 0a 20 20 20 20 70 75 74 pt 2848]. put
5f20: 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 s $f hello. c
5f30: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
5f40: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
5f50: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5f60: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
5f70: 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 x. after canc
5f80: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
5f90: 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d ose $s. renam
5fa0: 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 e bgerror {}.
5fb0: 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 set x.} {{divid
5fc0: 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 e by zero}}..tes
5fd0: 74 20 73 6f 63 6b 65 74 2d 37 2e 31 20 7b 74 65 t socket-7.1 {te
5fe0: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
5ff0: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
6000: 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 socket stdio pcC
6010: 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rash} {. remo
6020: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
6030: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
6040: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
6050: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
6060: 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a equire tls..tls:
6070: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6080: 61 63 63 65 70 74 20 32 38 32 30 0a 09 70 72 6f accept 2820..pro
6090: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
60a0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
60b0: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
60c0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
60d0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
60e0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
60f0: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
6100: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
6110: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
6120: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
6130: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
6140: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
6150: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
6160: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
6170: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6180: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
6190: 32 30 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 20]. set p [f
61a0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 65 configure $s -pe
61b0: 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ername]. clos
61c0: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
61d0: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
61e0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
61f0: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 ring compare [li
6200: 6e 64 65 78 20 24 70 20 30 5d 20 31 32 37 2e 30 ndex $p 0] 127.0
6210: 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 70 65 6e .0.1]. lappen
6220: 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 d l [string comp
6230: 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 are [lindex $p 2
6240: 5d 20 32 38 32 30 5d 0a 20 20 20 20 6c 61 70 70 ] 2820]. lapp
6250: 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 end l [llength $
6260: 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a 74 65 73 p].} {0 0 3}.tes
6270: 74 20 73 6f 63 6b 65 74 2d 37 2e 32 20 7b 74 65 t socket-7.2 {te
6280: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
6290: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
62a0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 socket stdio pcC
62b0: 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rash} {. remo
62c0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
62d0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
62e0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
62f0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
6300: 65 71 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a equire tls..tls:
6310: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6320: 61 63 63 65 70 74 20 32 38 32 31 0a 09 70 72 6f accept 2821..pro
6330: 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a c accept args {.
6340: 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 . global x..
6350: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
6360: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
6370: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
6380: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
6390: 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 d_out"]..vwait x
63a0: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
63b0: 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 timer. }.
63c0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
63d0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
63e0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
63f0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
6400: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
6410: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
6420: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
6430: 32 31 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 21]. set p [f
6440: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
6450: 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 ckname]. clos
6460: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
6470: 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 f. set l "".
6480: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c lappend l [ll
6490: 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 ength $p]. la
64a0: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
64b0: 24 70 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e $p 0]. lappen
64c0: 64 20 6c 20 5b 65 78 70 72 20 5b 6c 69 6e 64 65 d l [expr [linde
64d0: 78 20 24 70 20 32 5d 20 3d 3d 20 32 38 32 31 5d x $p 2] == 2821]
64e0: 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 .} {3 127.0.0.1
64f0: 30 7d 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 0}.test socket-7
6500: 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .3 {testing sock
6510: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
6520: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ons} {socket} {.
6530: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6540: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6550: 63 63 65 70 74 20 32 38 32 32 5d 0a 20 20 20 20 ccept 2822].
6560: 73 65 74 20 6c 20 5b 66 63 6f 6e 66 69 67 75 72 set l [fconfigur
6570: 65 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 e $s]. close
6580: 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 $s. update.
6590: 20 20 6c 6c 65 6e 67 74 68 20 24 6c 0a 7d 20 31 llength $l.} 1
65a0: 32 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 37 2e 2.test socket-7.
65b0: 34 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 4 {testing socke
65c0: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
65d0: 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 70 63 43 72 ns} {socket pcCr
65e0: 61 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ash} {. set s
65f0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
6600: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
6610: 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 3]. proc acce
6620: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
6630: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
6640: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
6650: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
6660: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
6670: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
6680: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
6690: 32 38 32 33 5d 0a 20 20 20 20 73 65 74 20 74 69 2823]. set ti
66a0: 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 mer [after 10000
66b0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
66c0: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a t"]. vwait x.
66d0: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
66e0: 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 $timer. clos
66f0: 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 e $s. close $
6700: 73 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a s1. set l "".
6710: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
6720: 69 6e 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 index $x 2] [lle
6730: 6e 67 74 68 20 24 78 5d 0a 7d 20 7b 32 38 32 33 ngth $x].} {2823
6740: 20 33 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 3}..test socket
6750: 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.5 {testing so
6760: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
6770: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 75 tions} {socket u
6780: 6e 69 78 4f 72 50 63 20 70 63 43 72 61 73 68 7d nixOrPc pcCrash}
6790: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
67a0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
67b0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
67c0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
67d0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
67e0: 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 verKey \. .-s
67f0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
6800: 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 9]. proc acce
6810: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
6820: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
6830: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
6840: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
6850: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
6860: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
6870: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
6880: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
6890: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
68a0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
68b0: 20 20 20 09 31 32 37 2e 30 2e 30 2e 31 20 32 38 .127.0.0.1 28
68c0: 32 39 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 29]. set time
68d0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
68e0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
68f0: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
6900: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
6910: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
6920: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
6930: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
6940: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
6950: 64 65 78 20 24 78 20 30 5d 20 5b 6c 69 6e 64 65 dex $x 0] [linde
6960: 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 x $x 2] [llength
6970: 20 24 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e 30 2e $x].} {127.0.0.
6980: 31 20 32 38 32 39 20 33 7d 0a 0a 74 65 73 74 20 1 2829 3}..test
6990: 73 6f 63 6b 65 74 2d 38 2e 31 20 7b 74 65 73 74 socket-8.1 {test
69a0: 69 6e 67 20 2d 61 73 79 6e 63 20 66 6c 61 67 20 ing -async flag
69b0: 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 7b 65 6d 70 on sockets} {emp
69c0: 74 79 20 73 6f 63 6b 65 74 20 70 63 43 72 61 73 ty socket pcCras
69d0: 68 7d 20 7b 0a 20 20 20 20 23 20 4e 4f 54 45 3a h} {. # NOTE:
69e0: 20 54 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 This test may f
69f0: 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 ail on some Sola
6a00: 72 69 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e ris 2.4 systems.
6a10: 20 49 66 20 69 74 20 64 6f 65 73 2c 0a 20 20 20 If it does,.
6a20: 20 23 20 63 68 65 63 6b 20 74 68 61 74 20 79 6f # check that yo
6a30: 75 20 68 61 76 65 20 74 68 65 73 65 20 70 61 74 u have these pat
6a40: 63 68 65 73 20 69 6e 73 74 61 6c 6c 65 64 20 28 ches installed (
6a50: 75 73 69 6e 67 20 73 68 6f 77 72 65 76 20 2d 70 using showrev -p
6a60: 29 3a 0a 20 20 20 20 23 0a 20 20 20 20 23 20 31 ):. #. # 1
6a70: 30 31 39 30 37 2d 30 35 2c 20 31 30 31 39 32 35 01907-05, 101925
6a80: 2d 30 32 2c 20 31 30 31 39 34 35 2d 31 34 2c 20 -02, 101945-14,
6a90: 31 30 31 39 35 39 2d 30 33 2c 20 31 30 31 39 36 101959-03, 10196
6aa0: 39 2d 30 35 2c 20 31 30 31 39 37 33 2d 30 33 2c 9-05, 101973-03,
6ab0: 0a 20 20 20 20 23 20 31 30 31 39 37 37 2d 30 33 . # 101977-03
6ac0: 2c 20 31 30 31 39 38 31 2d 30 32 2c 20 31 30 31 , 101981-02, 101
6ad0: 39 38 35 2d 30 31 2c 20 31 30 32 30 30 31 2d 30 985-01, 102001-0
6ae0: 33 2c 20 31 30 32 30 30 33 2d 30 31 2c 20 31 30 3, 102003-01, 10
6af0: 32 30 30 37 2d 30 31 2c 0a 20 20 20 20 23 20 31 2007-01,. # 1
6b00: 30 32 30 31 31 2d 30 32 2c 20 31 30 32 30 32 34 02011-02, 102024
6b10: 2d 30 31 2c 20 31 30 32 30 33 39 2d 30 31 2c 20 -01, 102039-01,
6b20: 31 30 32 30 34 34 2d 30 31 2c 20 31 30 32 30 34 102044-01, 10204
6b30: 38 2d 30 31 2c 20 31 30 32 30 36 32 2d 30 33 2c 8-01, 102062-03,
6b40: 0a 20 20 20 20 23 20 31 30 32 30 36 36 2d 30 34 . # 102066-04
6b50: 2c 20 31 30 32 30 37 30 2d 30 31 2c 20 31 30 32 , 102070-01, 102
6b60: 31 30 35 2d 30 31 2c 20 31 30 32 31 35 33 2d 30 105-01, 102153-0
6b70: 33 2c 20 31 30 32 32 31 36 2d 30 31 2c 20 31 30 3, 102216-01, 10
6b80: 32 32 33 32 2d 30 31 2c 0a 20 20 20 20 23 20 31 2232-01,. # 1
6b90: 30 31 38 37 38 2d 30 33 2c 20 31 30 31 38 37 39 01878-03, 101879
6ba0: 2d 30 31 2c 20 31 30 31 38 38 30 2d 30 33 2c 20 -01, 101880-03,
6bb0: 31 30 31 39 33 33 2d 30 31 2c 20 31 30 31 39 35 101933-01, 10195
6bc0: 30 2d 30 31 2c 20 31 30 32 30 33 30 2d 30 31 2c 0-01, 102030-01,
6bd0: 0a 20 20 20 20 23 20 31 30 32 30 35 37 2d 30 38 . # 102057-08
6be0: 2c 20 31 30 32 31 34 30 2d 30 31 2c 20 31 30 31 , 102140-01, 101
6bf0: 39 32 30 2d 30 32 2c 20 31 30 31 39 32 31 2d 30 920-02, 101921-0
6c00: 39 2c 20 31 30 31 39 32 32 2d 30 37 2c 20 31 30 9, 101922-07, 10
6c10: 31 39 32 33 2d 30 33 0a 20 20 20 20 23 0a 20 20 1923-03. #.
6c20: 20 20 23 20 49 66 20 61 66 74 65 72 20 69 6e 73 # If after ins
6c30: 74 61 6c 6c 69 6e 67 20 74 68 65 73 65 20 70 61 talling these pa
6c40: 74 63 68 65 73 20 79 6f 75 20 61 72 65 20 73 74 tches you are st
6c50: 69 6c 6c 20 65 78 70 65 72 69 65 6e 63 69 6e 67 ill experiencing
6c60: 20 61 0a 20 20 20 20 23 20 70 72 6f 62 6c 65 6d a. # problem
6c70: 2c 20 70 6c 65 61 73 65 20 65 6d 61 69 6c 20 6a , please email j
6c80: 79 6c 40 65 6e 67 2e 73 75 6e 2e 63 6f 6d 2e 20 yl@eng.sun.com.
6c90: 57 65 20 68 61 76 65 20 6e 6f 74 20 6f 62 73 65 We have not obse
6ca0: 72 76 65 64 20 74 68 69 73 0a 20 20 20 20 23 20 rved this. #
6cb0: 66 61 69 6c 75 72 65 20 6f 6e 20 53 6f 6c 61 72 failure on Solar
6cc0: 69 73 20 32 2e 35 2c 20 73 6f 20 61 6e 6f 74 68 is 2.5, so anoth
6cd0: 65 72 20 6f 70 74 69 6f 6e 20 28 69 6e 73 74 65 er option (inste
6ce0: 61 64 20 6f 66 20 69 6e 73 74 61 6c 6c 69 6e 67 ad of installing
6cf0: 0a 20 20 20 20 23 20 74 68 65 73 65 20 70 61 74 . # these pat
6d00: 63 68 65 73 29 20 69 73 20 74 6f 20 75 70 67 72 ches) is to upgr
6d10: 61 64 65 20 74 6f 20 53 6f 6c 61 72 69 73 20 32 ade to Solaris 2
6d20: 2e 35 2e 0a 20 20 20 20 73 65 74 20 73 20 5b 74 .5.. set s [t
6d30: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
6d40: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
6d50: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
6d60: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
6d70: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d rverKey \. .-
6d80: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
6d90: 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 30]. proc acc
6da0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 ept {s a p} {..g
6db0: 6c 6f 62 61 6c 20 78 0a 09 70 75 74 73 20 24 73 lobal x..puts $s
6dc0: 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 09 bye..close $s..
6dd0: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d set x done. }
6de0: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
6df0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
6e00: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
6e10: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6e20: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
6e30: 6e 74 4b 65 79 20 5c 0a 09 2d 61 73 79 6e 63 20 ntKey \..-async
6e40: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
6e50: 32 38 33 30 5d 0a 20 20 20 20 76 77 61 69 74 20 2830]. vwait
6e60: 78 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65 74 x. set z [get
6e70: 73 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 s $s1]. close
6e80: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
6e90: 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 1. set z.} by
6ea0: 65 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 39 e..test socket-9
6eb0: 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 .1 {testing spur
6ec0: 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 65 6d ious events} {em
6ed0: 70 74 79 20 73 6f 63 6b 65 74 20 70 63 43 72 61 pty socket pcCra
6ee0: 73 68 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 sh} {. set le
6ef0: 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 n 0. set spur
6f00: 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 ious 0. set d
6f10: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 one 0. proc r
6f20: 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a eadlittle {s} {.
6f30: 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 .global spurious
6f40: 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c done len..set l
6f50: 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 [read $s 1]..if
6f60: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
6f70: 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 $l] == 0} {..
6f80: 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d if {![eof $s]}
6f90: 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f {...incr spurio
6fa0: 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b us.. } else {
6fb0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
6fc0: 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a t done 1.. }.
6fd0: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 .} else {.. i
6fe0: 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 ncr len [string
6ff0: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 length $l]..}.
7000: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
7010: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
7020: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
7030: 66 66 65 72 69 6e 67 20 6e 6f 6e 65 20 2d 62 6c ffering none -bl
7040: 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 66 69 6c 65 ocking off..file
7050: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
7060: 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 74 e [list readlitt
7070: 6c 65 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 20 le $s]. }.
7080: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7090: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
70a0: 70 74 20 32 38 33 31 5d 0a 20 20 20 20 73 65 74 pt 2831]. set
70b0: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
70c0: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
70d0: 32 38 33 31 5d 0a 20 20 20 20 70 75 74 73 20 2d 2831]. puts -
70e0: 6e 6f 6e 65 77 6c 69 6e 65 20 24 63 20 30 31 32 nonewline $c 012
70f0: 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 3456789012345678
7100: 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 9012345678901234
7110: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 0a 567890123456789.
7120: 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 close $c.
7130: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
7140: 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 10000 "set don
7150: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
7160: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
7170: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
7180: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
7190: 73 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 72 s. list $spur
71a0: 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 ious $len.} {0 5
71b0: 30 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 0}..test socket-
71c0: 39 2e 32 20 7b 74 65 73 74 69 6e 67 20 61 73 79 9.2 {testing asy
71d0: 6e 63 20 77 72 69 74 65 2c 20 66 69 6c 65 65 76 nc write, fileev
71e0: 65 6e 74 73 2c 20 66 6c 75 73 68 20 6f 6e 20 63 ents, flush on c
71f0: 6c 6f 73 65 7d 20 7b 65 6d 70 74 79 20 73 6f 63 lose} {empty soc
7200: 6b 65 74 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 ket pcCrash} {.
7210: 20 20 20 73 65 74 20 66 69 72 73 74 62 6c 6f 63 set firstbloc
7220: 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 65 k "". for {se
7230: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 t i 0} {$i < 5}
7240: 7b 69 6e 63 72 20 69 7d 20 7b 73 65 74 20 66 69 {incr i} {set fi
7250: 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 rstblock "a$firs
7260: 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 tblock$firstbloc
7270: 6b 22 7d 0a 20 20 20 20 73 65 74 20 73 65 63 6f k"}. set seco
7280: 6e 64 62 6c 6f 63 6b 20 22 22 0a 20 20 20 20 66 ndblock "". f
7290: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
72a0: 20 3c 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d 20 < 16} {incr i}
72b0: 7b 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f {..set secondblo
72c0: 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 ck "b$secondbloc
72d0: 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 20 k$secondblock".
72e0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 20 5b }. set l [
72f0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
7300: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 32 5d ver accept 2832]
7310: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
7320: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
7330: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
7340: 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 ing 0 -translati
7350: 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a on lf -buffersiz
7360: 65 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 e 16384 \...-buf
7370: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c fering line..fil
7380: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
7390: 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 le "readable $s"
73a0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
73b0: 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 readable {s} {..
73c0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
73d0: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
73e0: 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 adable {}..after
73f0: 20 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 1000 respond $s
7400: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
7410: 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 respond {s} {..g
7420: 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b lobal firstblock
7430: 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e ..puts -nonewlin
7440: 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b e $s $firstblock
7450: 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 72 69 ..after 1000 wri
7460: 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a tedata $s. }.
7470: 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 proc writeda
7480: 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c ta {s} {..global
7490: 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 secondblock..pu
74a0: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
74b0: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 $secondblock..c
74c0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
74d0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
74e0: 63 6b 65 74 20 5b 69 6e 66 6f 20 68 6f 73 74 6e cket [info hostn
74f0: 61 6d 65 5d 20 32 38 33 32 5d 0a 20 20 20 20 66 ame] 2832]. f
7500: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
7510: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 ocking 0 -trans
7520: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
7530: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
7540: 20 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 0. puts $s h
7550: 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 ello. proc re
7560: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
7570: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 al count done..s
7580: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 et l [read $s]..
7590: 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 incr count [stri
75a0: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 ng length $l]..i
75b0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
75c0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 close $s..
75d0: 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a set done 1..}.
75e0: 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 }. fileev
75f0: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
7600: 22 72 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 "readit $s".
7610: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
7620: 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 10000 "set done
7630: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
7640: 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 vwait done.
7650: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
7660: 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 6c mer. close $l
7670: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a 7d . set count.}
7680: 20 36 35 35 36 36 0a 0a 74 65 73 74 20 73 6f 63 65566..test soc
7690: 6b 65 74 2d 39 2e 33 20 7b 74 65 73 74 69 6e 67 ket-9.3 {testing
76a0: 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d EOF stickyness}
76b0: 20 7b 65 6d 70 74 79 20 73 6f 63 6b 65 74 20 70 {empty socket p
76c0: 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 70 72 cCrash} {. pr
76d0: 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 oc count_to_eof
76e0: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f {s} {..global co
76f0: 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 unt done timer..
7700: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
7710: 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b .if {[eof $s]} {
7720: 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 .. incr count
7730: 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 .. if {$count
7740: 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 > 9} {...close
7750: 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 72 $s...set done tr
7760: 75 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 7b ue...set count {
7770: 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 eof is sticky}..
7780: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
7790: 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 imer.. }..}.
77a0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 }. proc ti
77b0: 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c merproc {} {..gl
77c0: 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 obal done count
77d0: 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 c..set done true
77e0: 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d ..set count {tim
77f0: 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 er went off, eof
7800: 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a is not sticky}.
7810: 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 .close $c. }.
7820: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 . set count 0
7830: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 66 61 . set done fa
7840: 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 72 69 lse. proc wri
7850: 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 te_then_close {s
7860: 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 79 65 } {..puts $s bye
7870: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
7880: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
7890: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
78a0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
78b0: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
78c0: 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 lation lf..filee
78d0: 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 vent $s writable
78e0: 20 22 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f "write_then_clo
78f0: 73 65 20 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 se $s". }.
7900: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7910: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
7920: 70 74 20 32 38 33 33 5d 0a 20 20 20 20 73 65 74 pt 2833]. set
7930: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
7940: 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 [info hostname]
7950: 32 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2833]. fconfi
7960: 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e gure $c -blockin
7970: 67 20 6f 66 66 20 2d 62 75 66 66 65 72 69 6e 67 g off -buffering
7980: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
7990: 6f 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 65 76 on lf. fileev
79a0: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
79b0: 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 63 "count_to_eof $c
79c0: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
79d0: 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 [after 1000 time
79e0: 72 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 69 74 rproc]. vwait
79f0: 20 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 65 20 done. close
7a00: 24 73 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 $s. set count
7a10: 0a 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b .} {eof is stick
7a20: 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 20 73 y}..removeFile s
7a30: 63 72 69 70 74 0a 0a 74 65 73 74 20 73 6f 63 6b cript..test sock
7a40: 65 74 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e 67 et-10.1 {testing
7a50: 20 73 6f 63 6b 65 74 20 61 63 63 65 70 74 20 63 socket accept c
7a60: 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 61 allback error ha
7a70: 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 20 ndling} {socket
7a80: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 73 pcCrash} {. s
7a90: 65 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 et goterror 0.
7aa0: 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 proc bgerror a
7ab0: 72 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 rgs {global gote
7ac0: 72 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 72 rror; set goterr
7ad0: 6f 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 20 or 1}. set s
7ae0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
7af0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
7b00: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
7b10: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
7b20: 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 serverKey \.
7b30: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
7b40: 32 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 2898]. proc a
7b50: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 ccept {s a p} {c
7b60: 6c 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a lose $s; error}.
7b70: 20 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a set c [tls:
7b80: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
7b90: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
7ba0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7bb0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
7bc0: 74 4b 65 79 20 5c 0a 09 31 32 37 2e 30 2e 30 2e tKey \..127.0.0.
7bd0: 31 20 32 38 39 38 5d 0a 20 20 20 20 76 77 61 69 1 2898]. vwai
7be0: 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 t goterror. c
7bf0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
7c00: 65 20 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 e $c. set got
7c10: 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 error.} 1..test
7c20: 73 6f 63 6b 65 74 2d 31 31 2e 31 20 7b 74 63 70 socket-11.1 {tcp
7c30: 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f connection} {so
7c40: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
7c50: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
7c60: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
7c70: 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 "set caCert $caC
7c80: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
7c90: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
7ca0: 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 Cert $serverCert
7cb0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
7cc0: 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 d "set clientCer
7cd0: 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 t $clientCert".
7ce0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
7cf0: 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 set serverKey $s
7d00: 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 erverKey". se
7d10: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
7d20: 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 lientKey $client
7d30: 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d Key". sendCom
7d40: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
7d50: 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 et9_1_test_serve
7d60: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
7d70: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
7d80: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
7d90: 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 verCert \...-caf
7da0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 ile $caCert \...
7db0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
7dc0: 4b 65 79 20 5c 0a 09 09 32 38 33 34 5d 0a 09 70 Key \...2834]..p
7dd0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
7de0: 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 p} {.. puts $
7df0: 73 20 64 6f 6e 65 0a 09 20 20 20 20 74 6c 73 3a s done.. tls:
7e00: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
7e10: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
7e20: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
7e30: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
7e40: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
7e50: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
7e60: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7e70: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
7e80: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
7e90: 72 49 50 20 32 38 33 34 5d 0a 20 20 20 20 73 65 rIP 2834]. se
7ea0: 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t r [gets $s].
7eb0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
7ec0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
7ed0: 65 20 24 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 e $socket9_1_tes
7ee0: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
7ef0: 74 20 72 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 74 t r.} done..test
7f00: 20 73 6f 63 6b 65 74 2d 31 31 2e 32 20 7b 63 6c socket-11.2 {cl
7f10: 69 65 6e 74 20 73 70 65 63 69 66 69 65 73 20 69 ient specifies i
7f20: 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 ts port} {socket
7f30: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
7f40: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
7f50: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
7f60: 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 caCert $caCert"
7f70: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
7f80: 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 "set serverCert
7f90: 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 $serverCert".
7fa0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
7fb0: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 et clientCert $c
7fc0: 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 lientCert". s
7fd0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
7fe0: 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 serverKey $serve
7ff0: 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f rKey". sendCo
8000: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
8010: 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 tKey $clientKey"
8020: 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 . if {[info e
8030: 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 xists port]} {..
8040: 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 incr port. }
8050: 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 else {..set port
8060: 20 5b 65 78 70 72 20 32 30 34 38 20 2b 20 5b 70 [expr 2048 + [p
8070: 69 64 5d 25 31 30 32 34 5d 0a 20 20 20 20 7d 0a id]%1024]. }.
8080: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8090: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 {..set socket9_2
80a0: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
80b0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
80c0: 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 r accept \...-ce
80d0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
80e0: 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 rt \...-cafile $
80f0: 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 caCert \...-keyf
8100: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
8110: 0a 09 20 20 20 20 32 38 33 35 5d 0a 09 70 72 6f .. 2835]..pro
8120: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
8130: 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 {.. puts $s
8140: 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 $p.. close $s
8150: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
8160: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
8170: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
8180: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
8190: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
81a0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
81b0: 79 20 5c 0a 09 20 20 20 20 2d 6d 79 70 6f 72 74 y \.. -myport
81c0: 20 24 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 $port $remoteSe
81d0: 72 76 65 72 49 50 20 32 38 33 35 5d 0a 20 20 20 rverIP 2835].
81e0: 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 5d set r [gets $s]
81f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
8200: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
8210: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f lose $socket9_2_
8220: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
8230: 20 69 66 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 if {$r == $port
8240: 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 } {..set result
8250: 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a ok. } else {.
8260: 09 73 65 74 20 72 65 73 75 6c 74 20 62 72 6f 6b .set result brok
8270: 65 6e 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 en. }. set
8280: 20 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a 74 65 73 result.} ok.tes
8290: 74 20 73 6f 63 6b 65 74 2d 31 31 2e 33 20 7b 74 t socket-11.3 {t
82a0: 72 79 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 63 74 rying to connect
82b0: 2c 20 6e 6f 20 73 65 72 76 65 72 7d 20 7b 73 6f , no server} {so
82c0: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
82d0: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
82e0: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 6f set status o
82f0: 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 k. if {![catc
8300: 68 20 7b 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 h {set s [tls::s
8310: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
8320: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
8330: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
8340: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
8350: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
8360: 65 6d 6f 74 65 53 65 72 76 65 72 49 70 20 32 38 emoteServerIp 28
8370: 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 36]}]} {..if {![
8380: 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 7d 5d catch {gets $s}]
8390: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 } {.. set sta
83a0: 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 tus broken..}..c
83b0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 lose $s. }.
83c0: 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f set status.} o
83d0: 6b 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 k..test socket-1
83e0: 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 1.4 {remote echo
83f0: 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 , one line} {soc
8400: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
8410: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
8420: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8430: 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 65 set caCert $caCe
8440: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8450: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 43 and "set serverC
8460: 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 22 ert $serverCert"
8470: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8480: 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 "set clientCert
8490: 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 $clientCert".
84a0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
84b0: 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 et serverKey $se
84c0: 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e rverKey". sen
84d0: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
84e0: 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b ientKey $clientK
84f0: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
8500: 61 6e 64 20 7b 0a 20 20 20 20 09 67 6c 6f 62 61 and {. .globa
8510: 6c 20 73 65 72 76 65 72 43 65 72 74 0a 09 67 6c l serverCert..gl
8520: 6f 62 61 6c 20 63 61 43 65 72 74 0a 09 67 6c 6f obal caCert..glo
8530: 62 61 6c 20 73 65 72 76 65 72 4b 65 79 0a 09 73 bal serverKey..s
8540: 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 et socket10_6_te
8550: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
8560: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
8570: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
8580: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 \...-cafile $ca
8590: 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c Cert \...-keyfil
85a0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
85b0: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
85c0: 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 2836]..proc acce
85d0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
85e0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
85f0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
8600: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
8610: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
8620: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
8630: 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 lation crlf..}..
8640: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
8650: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
8660: 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 $s].. if {[e
8670: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 of $s]} {...clos
8680: 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 e $s.. } else
8690: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a {...puts $s $l.
86a0: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
86b0: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
86c0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
86d0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
86e0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
86f0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
8700: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
8710: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
8720: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
8730: 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 ure $f -translat
8740: 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 ion crlf -buffer
8750: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 ing line. put
8760: 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 s $f hello. s
8770: 65 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 et r [gets $f].
8780: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
8790: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
87a0: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 se $socket10_6_t
87b0: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
87c0: 73 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 set r.} hello..t
87d0: 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 35 20 est socket-11.5
87e0: 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 {remote echo, 50
87f0: 20 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 lines} {socket
8800: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
8810: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
8820: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
8830: 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a caCert $caCert".
8840: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8850: 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 "set serverCert
8860: 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 $serverCert".
8870: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
8880: 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c t clientCert $cl
8890: 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 ientCert". se
88a0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
88b0: 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 erverKey $server
88c0: 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d Key". sendCom
88d0: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
88e0: 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a Key $clientKey".
88f0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8900: 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f {..set socket10_
8910: 37 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 7_test_server [t
8920: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
8930: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 er accept \...-c
8940: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
8950: 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 ert \...-cafile
8960: 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 $caCert \...-key
8970: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8980: 5c 0a 09 09 32 38 33 36 5d 0a 09 70 72 6f 63 20 \...2836]..proc
8990: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
89a0: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
89b0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
89c0: 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 t echo $s]..
89d0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
89e0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
89f0: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a ranslation crlf.
8a00: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
8a10: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
8a20: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
8a30: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
8a40: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
8a50: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
8a60: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
8a70: 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 }. set f [t
8a80: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
8a90: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
8aa0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
8ab0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8ac0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
8ad0: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
8ae0: 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 2836]. fco
8af0: 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e nfigure $f -tran
8b00: 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 slation crlf -bu
8b10: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
8b20: 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d for {set cnt 0}
8b30: 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e {$cnt < 50} {in
8b40: 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 cr cnt} {..puts
8b50: 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 $f "hello, $cnt"
8b60: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f ..if {[string co
8b70: 6d 70 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 mpare [gets $f]
8b80: 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 "hello, $cnt"] !
8b90: 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 = 0} {.. brea
8ba0: 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 k..}. }. c
8bb0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 lose $f. send
8bc0: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
8bd0: 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f socket10_7_test_
8be0: 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 server}. set
8bf0: 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 69 cnt.} 50..# Maci
8c00: 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 ntosh sockets ca
8c10: 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e n have more than
8c20: 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 one server per
8c30: 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c port.if {$tcl_pl
8c40: 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 atform(platform)
8c50: 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d == "macintosh"}
8c60: 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c {. set confl
8c70: 69 63 74 52 65 73 75 6c 74 20 7b 30 20 32 38 33 ictResult {0 283
8c80: 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 6}.} else {.
8c90: 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 set conflictResu
8ca0: 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 lt {1 {couldn't
8cb0: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 open socket: add
8cc0: 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 ress already in
8cd0: 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 73 6f use}}.}..test so
8ce0: 63 6b 65 74 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 cket-11.6 {socke
8cf0: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 t conflict} {soc
8d00: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
8d10: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
8d20: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
8d30: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
8d40: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
8d50: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
8d60: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
8d70: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
8d80: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
8d90: 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 36]. if {[cat
8da0: 63 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a ch {set s2 [tls:
8db0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
8dc0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
8dd0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8de0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
8df0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
8e00: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
8e10: 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 836]} msg]} {..s
8e20: 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 et result [list
8e30: 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 1 $msg]. } el
8e40: 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 se {..set result
8e50: 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 [list 0 [lindex
8e60: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 [fconfigure $s2
8e70: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a -sockname] 2]].
8e80: 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d .close $s2. }
8e90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
8ea0: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 set result.}
8eb0: 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a $conflictResult.
8ec0: 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e .test socket-11.
8ed0: 37 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 7 {server with s
8ee0: 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 everal clients}
8ef0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
8f00: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
8f10: 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 {. sendComma
8f20: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
8f30: 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 65 72 10_9_test_server
8f40: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8f50: 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c ..-certfile [fil
8f60: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
8f70: 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c ts server.pem] \
8f80: 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 ...-cafile [file
8f90: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
8fa0: 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a s caFile.pem] \.
8fb0: 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 ..-keyfile [file
8fc0: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
8fd0: 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 s skey.pem] \...
8fe0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
8ff0: 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 836]..proc accep
9000: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
9010: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
9020: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
9030: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
9040: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
9050: 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 6f echo $s]..}..pro
9060: 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 c echo {s} {..
9070: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
9080: 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 ].. if {[eof
9090: 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 $s]} {...close $
90a0: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
90b0: 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 ..puts $s $l..
90c0: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
90d0: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
90e0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
90f0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
9100: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9110: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
9120: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
9130: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 moteServerIP 283
9140: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
9150: 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 e $s1 -buffering
9160: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 line. set s2
9170: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9180: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9190: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
91a0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
91b0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
91c0: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
91d0: 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 verIP 2836].
91e0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d fconfigure $s2 -
91f0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
9200: 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a set s3 [tls::
9210: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9220: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
9230: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9240: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
9250: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
9260: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
9270: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
9280: 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 ure $s3 -bufferi
9290: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 ng line. for
92a0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
92b0: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
92c0: 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c .puts $s1 hello,
92d0: 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 s1..gets $s1..pu
92e0: 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a ts $s2 hello,s2.
92f0: 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 .gets $s2..puts
9300: 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 $s3 hello,s3..ge
9310: 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 ts $s3. }.
9320: 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 close $s1. c
9330: 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f lose $s2. clo
9340: 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 se $s3. sendC
9350: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
9360: 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 ocket10_9_test_s
9370: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 69 erver}. set i
9380: 0a 7d 20 31 30 30 20 20 20 20 0a 0a 74 65 73 74 .} 100 ..test
9390: 20 73 6f 63 6b 65 74 2d 31 31 2e 38 20 7b 63 6c socket-11.8 {cl
93a0: 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 ient with severa
93b0: 6c 20 73 65 72 76 65 72 73 7d 20 7b 6b 6e 6f 77 l servers} {know
93c0: 6e 42 75 67 20 73 6f 63 6b 65 74 20 64 6f 54 65 nBug socket doTe
93d0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
93e0: 76 65 72 7d 20 7b 0a 09 23 20 74 68 69 73 20 6f ver} {..# this o
93f0: 6e 65 20 73 65 65 6d 73 20 74 6f 20 68 61 6e 67 ne seems to hang
9400: 20 2d 2d 20 61 77 62 20 36 2f 32 2f 32 30 30 30 -- awb 6/2/2000
9410: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9420: 20 7b 0a 09 73 65 74 20 73 31 20 5b 74 6c 73 3a {..set s1 [tls:
9430: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
9440: 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e tfile [file join
9450: 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 65 72 [pwd] certs ser
9460: 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 ver.pem] \...-ca
9470: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
9480: 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 46 69 [pwd] certs caFi
9490: 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 le.pem] \...-key
94a0: 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 file [file join
94b0: 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b 65 79 [pwd] certs skey
94c0: 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 76 65 .pem] \...-serve
94d0: 72 20 22 61 63 63 65 70 74 20 34 30 30 33 22 20 r "accept 4003"
94e0: 34 30 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 74 4003]..set s2 [t
94f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d ls::socket \...-
9500: 63 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a certfile [file j
9510: 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 oin [pwd] certs
9520: 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 server.pem] \...
9530: 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f -cafile [file jo
9540: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 in [pwd] certs c
9550: 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d aFile.pem] \...-
9560: 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f keyfile [file jo
9570: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 in [pwd] certs s
9580: 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 key.pem] \...-se
9590: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
95a0: 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 73 33 4" 4004]..set s3
95b0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
95c0: 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c ..-certfile [fil
95d0: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
95e0: 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c ts server.pem] \
95f0: 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 ...-cafile [file
9600: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9610: 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a s caFile.pem] \.
9620: 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 ..-keyfile [file
9630: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9640: 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 s skey.pem] \...
9650: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
9660: 34 30 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 4005" 4005]..pro
9670: 63 20 61 63 63 65 70 74 20 7b 6d 70 20 73 20 61 c accept {mp s a
9680: 20 70 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 p} {.. puts
9690: 24 73 20 24 6d 70 0a 09 20 20 20 20 63 6c 6f 73 $s $mp.. clos
96a0: 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 e $s..}. }.
96b0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
96c0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
96d0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
96e0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
96f0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9700: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9710: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 emoteServerIP 40
9720: 30 33 5d 0a 20 20 20 20 73 65 74 20 73 32 20 5b 03]. set s2 [
9730: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9740: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
9750: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
9760: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9770: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
9780: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
9790: 72 49 50 20 34 30 30 34 5d 0a 20 20 20 20 73 65 rIP 4004]. se
97a0: 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s3 [tls::socke
97b0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
97c0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
97d0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
97e0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
97f0: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
9800: 65 53 65 72 76 65 72 49 50 20 34 30 30 35 5d 0a eServerIP 4005].
9810: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
9820: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 lappend l [gets
9830: 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 31 5d $s1] [gets $s1]
9840: 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 [eof $s1] [gets
9850: 20 24 73 32 5d 20 5b 67 65 74 73 20 24 73 32 5d $s2] [gets $s2]
9860: 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 [eof $s2] \..[g
9870: 65 74 73 20 24 73 33 5d 20 5b 67 65 74 73 20 24 ets $s3] [gets $
9880: 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 s3] [eof $s3].
9890: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
98a0: 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 6c close $s2. cl
98b0: 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e 64 ose $s3. send
98c0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 Command {..close
98d0: 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a $s1..close $s2.
98e0: 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 7d .close $s3. }
98f0: 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 . set l.} {40
9900: 30 33 20 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 03 {} 1 4004 {}
9910: 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 1 4005 {} 1}..te
9920: 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 39 20 7b st socket-11.9 {
9930: 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 accept callback
9940: 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 70 error} {socket p
9950: 63 43 72 61 73 68 20 64 6f 54 65 73 74 73 57 69 cCrash doTestsWi
9960: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9970: 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 {. set s [tls
9980: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9990: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
99a0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
99b0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
99c0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
99d0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
99e0: 32 38 33 36 5d 0a 20 20 20 20 70 72 6f 63 20 61 2836]. proc a
99f0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 ccept {s a p} {e
9a00: 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 xpr 10 / 0}.
9a10: 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 proc bgerror arg
9a20: 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 s {..global x..s
9a30: 65 74 20 78 20 24 61 72 67 73 0a 20 20 20 20 7d et x $args. }
9a40: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9a50: 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 "set caCert $ca
9a60: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
9a70: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
9a80: 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 rCert $serverCer
9a90: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
9aa0: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 nd "set clientCe
9ab0: 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a rt $clientCert".
9ac0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
9ad0: 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 "set serverKey $
9ae0: 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 serverKey". s
9af0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
9b00: 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e clientKey $clien
9b10: 74 4b 65 79 22 0a 20 20 20 20 69 66 20 7b 5b 63 tKey". if {[c
9b20: 61 74 63 68 20 7b 73 65 6e 64 43 6f 6d 6d 61 6e atch {sendComman
9b30: 64 20 7b 0a 09 20 20 20 20 73 65 74 20 70 65 65 d {.. set pee
9b40: 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 69 67 75 72 rname [fconfigur
9b50: 65 20 24 63 61 6c 6c 65 72 53 6f 63 6b 65 74 20 e $callerSocket
9b60: 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 20 20 20 20 -peername]..
9b70: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
9b80: 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 et \...-certfile
9b90: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 5c 0a 09 $clientCert \..
9ba0: 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 .-cafile $caCert
9bb0: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 63 \...-keyfile $c
9bc0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
9bd0: 09 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 6e 61 .[lindex $peerna
9be0: 6d 65 20 30 5d 20 32 38 33 36 5d 0a 09 20 20 20 me 0] 2836]..
9bf0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 09 20 close $s. .
9c00: 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c 6f 73 }} msg]} {..clos
9c10: 65 20 24 73 0a 09 65 72 72 6f 72 20 24 6d 73 67 e $s..error $msg
9c20: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 74 . }. set t
9c30: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
9c40: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
9c50: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut"]. vwait x
9c60: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
9c70: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
9c80: 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 se $s. rename
9c90: 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 bgerror {}.
9ca0: 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 set x.} {{divide
9cb0: 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 74 by zero}}..test
9cc0: 20 73 6f 63 6b 65 74 2d 31 31 2e 31 30 20 7b 74 socket-11.10 {t
9cd0: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 esting socket sp
9ce0: 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 ecific options}
9cf0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
9d00: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
9d10: 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 {. sendComma
9d20: 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 nd "set caCert $
9d30: 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 caCert". send
9d40: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
9d50: 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 verCert $serverC
9d60: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
9d70: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
9d80: 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 Cert $clientCert
9d90: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
9da0: 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 d "set serverKey
9db0: 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 $serverKey".
9dc0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
9dd0: 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 t clientKey $cli
9de0: 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 entKey". send
9df0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
9e00: 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f ocket10_12_test_
9e10: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
9e20: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
9e30: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
9e40: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
9e50: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
9e60: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
9e70: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
9e80: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
9e90: 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 {s a p} {close $
9ea0: 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 s}. }. set
9eb0: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
9ec0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9ed0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9ee0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9ef0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9f00: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9f10: 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 erverIP 2836].
9f20: 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 set p [fconfig
9f30: 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d 65 ure $s -peername
9f40: 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b 66 63 6f ]. set n [fco
9f50: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
9f60: 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6c 20 name]. set l
9f70: 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c "". lappend l
9f80: 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 5b [lindex $p 2] [
9f90: 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b 6c 6c 65 llength $p] [lle
9fa0: 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 63 6c 6f ngth $p]. clo
9fb0: 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f se $s. sendCo
9fc0: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
9fd0: 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 cket10_12_test_s
9fe0: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 6c erver}. set l
9ff0: 0a 7d 20 7b 32 38 33 36 20 33 20 33 7d 0a 0a 74 .} {2836 3 3}..t
a000: 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 31 est socket-11.11
a010: 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f {testing spurio
a020: 75 73 20 65 76 65 6e 74 73 7d 20 7b 65 6d 70 74 us events} {empt
a030: 79 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 y socket doTests
a040: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
a050: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d } {. sendComm
a060: 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 and "set caCert
a070: 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e $caCert". sen
a080: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
a090: 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 rverCert $server
a0a0: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
a0b0: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
a0c0: 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 tCert $clientCer
a0d0: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
a0e0: 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 nd "set serverKe
a0f0: 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 y $serverKey".
a100: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
a110: 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c et clientKey $cl
a120: 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e ientKey". sen
a130: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
a140: 73 6f 63 6b 65 74 31 30 5f 31 33 5f 74 65 73 74 socket10_13_test
a150: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
a160: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
a170: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c le $serverCert \
a180: 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 ...-cafile $caCe
a190: 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 rt \...-keyfile
a1a0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d $serverKey \...-
a1b0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
a1c0: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
a1d0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
a1e0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
a1f0: 72 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f ranslation "auto
a200: 20 6c 66 22 0a 09 20 20 20 20 61 66 74 65 72 20 lf".. after
a210: 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 24 73 100 writesome $s
a220: 0a 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 73 ..}..proc writes
a230: 6f 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 66 ome {s} {.. f
a240: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
a250: 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d < 100} {incr i}
a260: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 22 6c 69 {...puts $s "li
a270: 6e 65 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f 74 ne $i from remot
a280: 65 20 73 65 72 76 65 72 22 0a 09 20 20 20 20 7d e server".. }
a290: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
a2a0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
a2b0: 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 len 0. set sp
a2c0: 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 urious 0. set
a2d0: 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 done 0. proc
a2e0: 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 readlittle {s}
a2f0: 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f {..global spurio
a300: 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 us done len..set
a310: 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 l [read $s 1]..
a320: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 if {[string leng
a330: 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 th $l] == 0} {..
a340: 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 if {![eof $s
a350: 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 ]} {...incr spur
a360: 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 ious.. } else
a370: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 {...close $s...
a380: 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 set done 1..
a390: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 }..} else {..
a3a0: 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e incr len [strin
a3b0: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a g length $l]..}.
a3c0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 }. set c
a3d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a3e0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
a3f0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
a400: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a410: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
a420: 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 . $remoteServ
a430: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 erIP 2836]. f
a440: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
a450: 61 62 6c 65 20 22 72 65 61 64 6c 69 74 74 6c 65 able "readlittle
a460: 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d $c". set tim
a470: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
a480: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
a490: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
a4a0: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
a4b0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
a4c0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
a4d0: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 33 ose $socket10_13
a4e0: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
a4f0: 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 list $spurious
a500: 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d $len.} {0 2690}
a510: 0a 0a 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 ..test socket-11
a520: 2e 31 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 .12 {testing EOF
a530: 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 73 6f stickyness} {so
a540: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
a550: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
a560: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 set counter
a570: 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0. set done 0
a580: 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f . proc count_
a590: 75 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c up {s} {..global
a5a0: 20 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 counter done af
a5b0: 74 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 ter_id..set l [g
a5c0: 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f ets $s]..if {[eo
a5d0: 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e f $s]} {.. in
a5e0: 63 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 cr counter..
a5f0: 69 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 if {$counter > 9
a600: 7d 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b } {...set done {
a610: 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 EOF is sticky}..
a620: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 .after cancel $a
a630: 66 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 fter_id...close
a640: 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 $s.. }..}.
a650: 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 }. proc time
a660: 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 d_out {} {..glob
a670: 61 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 al c done..set d
a680: 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 one {timed_out,
a690: 45 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b EOF is not stick
a6a0: 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 y}..close $c.
a6b0: 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }. sendComma
a6c0: 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 nd "set caCert $
a6d0: 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 caCert". send
a6e0: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
a6f0: 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 verCert $serverC
a700: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a710: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
a720: 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 Cert $clientCert
a730: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
a740: 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 d "set serverKey
a750: 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 $serverKey".
a760: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
a770: 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 t clientKey $cli
a780: 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 entKey". send
a790: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
a7a0: 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f ocket10_14_test_
a7b0: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
a7c0: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
a7d0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
a7e0: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
a7f0: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
a800: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
a810: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 erver accept 283
a820: 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 6]..proc accept
a830: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 61 {s a p} {.. a
a840: 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 24 fter 100 close $
a850: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
a860: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
a870: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
a880: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
a890: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a8a0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
a8b0: 65 79 20 5c 0a 20 20 20 20 09 24 72 65 6d 6f 74 ey \. .$remot
a8c0: 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a eServerIP 2836].
a8d0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
a8e0: 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 readable "count
a8f0: 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 74 20 _up $c". set
a900: 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 72 20 after_id [after
a910: 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 1000 timed_out].
a920: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
a930: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
a940: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
a950: 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 14_test_server}.
a960: 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b set done.} {
a970: 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a EOF is sticky}..
a980: 74 65 73 74 20 73 6f 63 6b 65 74 2d 31 31 2e 31 test socket-11.1
a990: 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 3 {testing async
a9a0: 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 6c write, async fl
a9b0: 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 ush, async close
a9c0: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
a9d0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
a9e0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 rver} {. proc
a9f0: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
aa00: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
aa10: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
aa20: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
aa30: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
aa40: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
aa50: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
aa60: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
aa70: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e .}. }. sen
aa80: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 dCommand "set ca
aa90: 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 Cert $caCert".
aaa0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
aab0: 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 et serverCert $s
aac0: 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 erverCert". s
aad0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
aae0: 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 clientCert $clie
aaf0: 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 ntCert". send
ab00: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
ab10: 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 verKey $serverKe
ab20: 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 y". sendComma
ab30: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 nd "set clientKe
ab40: 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 y $clientKey".
ab50: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a sendCommand {.
ab60: 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 .set firstblock
ab70: 22 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 ""..for {set i 0
ab80: 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 } {$i < 5} {incr
ab90: 20 69 7d 20 7b 0a 09 09 73 65 74 20 66 69 72 73 i} {...set firs
aba0: 74 62 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 62 tblock "a$firstb
abb0: 6c 6f 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 lock$firstblock"
abc0: 0a 09 7d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 ..}..set secondb
abd0: 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 lock ""..for {se
abe0: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 7d t i 0} {$i < 16}
abf0: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 {incr i} {..
ac00: 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b set secondblock
ac10: 20 22 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 "b$secondblock$
ac20: 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 0a 09 7d 0a secondblock"..}.
ac30: 09 73 65 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 .set l [tls::soc
ac40: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
ac50: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a e $serverCert \.
ac60: 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 ..-cafile $caCer
ac70: 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 t \...-keyfile $
ac80: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 serverKey \...-s
ac90: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 34 erver accept 284
aca0: 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 5]..proc accept
acb0: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 {s a p} {.. f
acc0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
acd0: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c ocking 0 -transl
ace0: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
acf0: 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 2d size 16384 \...-
ad00: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
ad10: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
ad20: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 readable "reada
ad30: 62 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 ble $s"..}..proc
ad40: 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a readable {s} {.
ad50: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
ad60: 20 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 $s].. fileev
ad70: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
ad80: 7b 7d 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 {}.. after 10
ad90: 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 00 respond $s..}
ada0: 0a 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b ..proc respond {
adb0: 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c s} {.. global
adc0: 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 firstblock..
add0: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
ade0: 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a $s $firstblock.
adf0: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
ae00: 77 72 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a writedata $s..}.
ae10: 09 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 .proc writedata
ae20: 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 {s} {.. globa
ae30: 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 l secondblock..
ae40: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
ae50: 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f ne $s $secondblo
ae60: 63 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 ck.. close $s
ae70: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
ae80: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
ae90: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
aea0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
aeb0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
aec0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
aed0: 79 20 5c 0a 20 20 20 20 09 24 72 65 6d 6f 74 65 y \. .$remote
aee0: 53 65 72 76 65 72 49 50 20 32 38 34 35 5d 0a 20 ServerIP 2845].
aef0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
af00: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 -blocking 0 -tr
af10: 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e ans lf -bufferin
af20: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 g line. set c
af30: 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 ount 0. puts
af40: 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 6c $s hello. fil
af50: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
af60: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 le "readit $s".
af70: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
af80: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 ter 10000 "set d
af90: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a one timed_out"].
afa0: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
afb0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
afc0: 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 43 $timer. sendC
afd0: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 6c ommand {close $l
afe0: 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 0a }. set count.
aff0: 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 73 6f } 65566..test so
b000: 63 6b 65 74 2d 31 32 2e 31 20 7b 74 65 73 74 69 cket-12.1 {testi
b010: 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f ng inheritance o
b020: 66 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 73 f server sockets
b030: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
b040: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b050: 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rver} {. remo
b060: 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 veFile script1.
b070: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
b080: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
b090: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
b0a0: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
b0b0: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
b0c0: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
b0d0: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
b0e0: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
b0f0: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
b100: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
b110: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
b120: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
b130: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
b140: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
b150: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
b160: 20 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 # Script2 creat
b170: 65 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f es the server so
b180: 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 cket, launches s
b190: 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 cript1,. # wa
b1a0: 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e its a second, an
b1b0: 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 d exits. The se
b1c0: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c rver socket will
b1d0: 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c now. # be cl
b1e0: 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 osed unless scri
b1f0: 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 pt1 inherited it
b200: 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 ... set f [op
b210: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
b220: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
b230: 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a 74 set tcltest $::t
b240: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d cltest::tcltest]
b250: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
b260: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
b270: 74 63 6c 74 65 73 74 0a 09 70 61 63 6b 61 67 65 tcltest..package
b280: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
b290: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
b2a0: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
b2b0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
b2c0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
b2d0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
b2e0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
b2f0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 e $serverKey 282
b300: 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 8 \]". puts $
b310: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
b320: 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 6f 72 { file addr por
b330: 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 t } {.. close
b340: 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65 63 20 $file..}..exec
b350: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
b360: 65 73 74 20 73 63 72 69 70 74 31 20 26 0a 09 63 est script1 &..c
b370: 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 72 20 31 lose $f..after 1
b380: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
b390: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
b3a0: 20 20 63 6c 6f 73 65 20 24 66 0a 09 0a 20 20 20 close $f...
b3b0: 20 23 20 4c 61 75 6e 63 68 20 73 63 72 69 70 74 # Launch script
b3c0: 32 20 61 6e 64 20 77 61 69 74 20 35 20 73 65 63 2 and wait 5 sec
b3d0: 6f 6e 64 73 0a 0a 20 20 20 20 65 78 65 63 20 24 onds.. exec $
b3e0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
b3f0: 73 74 20 73 63 72 69 70 74 32 20 26 0a 20 20 20 st script2 &.
b400: 20 61 66 74 65 72 20 35 30 30 30 20 7b 20 73 65 after 5000 { se
b410: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 t ok_to_proceed
b420: 31 20 7d 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 1 }. vwait ok
b430: 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 _to_proceed..
b440: 20 23 20 49 66 20 77 65 20 63 61 6e 20 73 74 69 # If we can sti
b450: 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 ll connect to th
b460: 65 20 73 65 72 76 65 72 2c 20 74 68 65 20 73 6f e server, the so
b470: 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 69 74 cket got inherit
b480: 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 ed... if {[ca
b490: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
b4a0: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
b4b0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
b4c0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b4d0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
b4e0: 20 20 20 09 20 31 32 37 2e 30 2e 30 2e 31 20 32 . 127.0.0.1 2
b4f0: 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 828} msg]} {..se
b500: 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b t x {server sock
b510: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
b520: 69 74 65 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 ited}. } else
b530: 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 {..close $msg..
b540: 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f set x {server so
b550: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
b560: 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 72 ed}. }.. r
b570: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
b580: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
b590: 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 script2. set
b5a0: 20 78 0a 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 x.} {server soc
b5b0: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
b5c0: 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 73 6f 63 rited}..test soc
b5d0: 6b 65 74 2d 31 32 2e 32 20 7b 74 65 73 74 69 6e ket-12.2 {testin
b5e0: 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 g inheritance of
b5f0: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 73 7d client sockets}
b600: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 \..{socket doTe
b610: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
b620: 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ver} {. remov
b630: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
b640: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
b650: 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 ipt2.. # Scri
b660: 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 pt1 is just a 10
b670: 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 second delay.
b680: 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 6f If the server so
b690: 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e cket. # is in
b6a0: 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c herited, it will
b6b0: 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f be held open fo
b6c0: 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 r 10 seconds..
b6d0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
b6e0: 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 ript1 w]. put
b6f0: 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 s $f {..after 10
b700: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
b710: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
b720: 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 close $f..
b730: 23 20 53 63 72 69 70 74 32 20 6f 70 65 6e 73 20 # Script2 opens
b740: 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 the client socke
b750: 74 20 61 6e 64 20 77 72 69 74 65 73 20 74 6f 20 t and writes to
b760: 69 74 2e 20 20 49 74 20 74 68 65 6e 0a 20 20 20 it. It then.
b770: 20 23 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 # launches scri
b780: 70 74 31 20 61 6e 64 20 65 78 69 74 73 2e 20 20 pt1 and exits.
b790: 49 66 20 74 68 65 20 63 68 69 6c 64 20 70 72 6f If the child pro
b7a0: 63 65 73 73 20 69 6e 68 65 72 69 74 65 64 20 74 cess inherited t
b7b0: 68 65 0a 20 20 20 20 23 20 63 6c 69 65 6e 74 20 he. # client
b7c0: 73 6f 63 6b 65 74 2c 20 74 68 65 20 73 6f 63 6b socket, the sock
b7d0: 65 74 20 77 69 6c 6c 20 73 74 69 6c 6c 20 62 65 et will still be
b7e0: 20 6f 70 65 6e 2e 0a 0a 20 20 20 20 73 65 74 20 open... set
b7f0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 f [open script2
b800: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
b810: 6c 69 73 74 20 73 65 74 20 74 63 6c 74 65 73 74 list set tcltest
b820: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
b830: 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 test]. puts $
b840: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
b850: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
b860: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
b870: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
b880: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
b890: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
b8a0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b8b0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
b8c0: 37 2e 30 2e 30 2e 31 20 32 38 32 39 20 5c 5d 22 7.0.0.1 2829 \]"
b8d0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
b8e0: 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a exec $::tcltest:
b8f0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 :tcltest script1
b900: 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 &..puts $f test
b910: 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 ing..flush $f..a
b920: 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 fter 1000 exit..
b930: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
b940: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
b950: 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 74 .. # Create t
b960: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
b970: 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 .. set server
b980: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
b990: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
b9a0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
b9b0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b9c0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 2d 73 $serverKey \..-s
b9d0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
b9e0: 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 9]. proc acce
b9f0: 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 70 pt { file host p
ba00: 6f 72 74 20 7d 20 7b 0a 0a 09 23 20 57 68 65 6e ort } {...# When
ba10: 20 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e the client conn
ba20: 65 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 20 ects, establish
ba30: 74 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 72 the read handler
ba40: 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a ..global server.
ba50: 09 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a 09 .close $server..
ba60: 66 69 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 20 fileevent $file
ba70: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 readable [list g
ba80: 65 74 64 61 74 61 20 24 66 69 6c 65 5d 0a 09 66 etdata $file]..f
ba90: 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 20 configure $file
baa0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 -buffering line
bab0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 72 65 74 -blocking 0..ret
bac0: 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 urn. }. pr
bad0: 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 6c oc getdata { fil
bae0: 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 e } {...# Read h
baf0: 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 63 andler on the ac
bb00: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a 09 cepted socket...
bb10: 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c global x..global
bb20: 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 failed..set sta
bb30: 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 tus [catch {read
bb40: 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 $file} data]..i
bb50: 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d f {$status != 0}
bb60: 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 {.. set x {r
bb70: 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f ead failed, erro
bb80: 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 r was $data}..
bb90: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
bba0: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 $file }..} elsei
bbb0: 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 f {[string compa
bbc0: 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a re {} $data]} {.
bbd0: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f .} elseif {[fblo
bbe0: 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 cked $file]} {..
bbf0: 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 } elseif {[eof $
bc00: 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 file]} {.. if
bc10: 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 {$failed} {...s
bc20: 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 et x {client soc
bc30: 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 ket was inherite
bc40: 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b d}.. } else {
bc50: 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 ...set x {client
bc60: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
bc70: 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 inherited}..
bc80: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
bc90: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 lose $file }..}
bca0: 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 else {.. set
bcb0: 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 x {impossible ca
bcc0: 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b se}.. catch {
bcd0: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 close $file }..
bce0: 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a }..return. }.
bcf0: 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f . # If the so
bd00: 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 74 cket doesn't hit
bd10: 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e 20 end-of-file in
bd20: 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 20 5 seconds, the.
bd30: 20 20 20 23 20 73 63 72 69 70 74 31 20 70 72 6f # script1 pro
bd40: 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 69 cess must have i
bd50: 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 6c 69 nherited the cli
bd60: 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 ent... set fa
bd70: 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 iled 0. after
bd80: 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 20 5000 [list set
bd90: 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 23 failed 1].. #
bda0: 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 69 Launch the scri
bdb0: 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 20 pt2 process..
bdc0: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
bdd0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
bde0: 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 2 &.. vwait x
bdf0: 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 . if {!$faile
be00: 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c d} {..vwait fail
be10: 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 6d ed. }. rem
be20: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a oveFile script1.
be30: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
be40: 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 cript2. set x
be50: 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 .} {client socke
be60: 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 t was not inheri
be70: 74 65 64 7d 0a 0a 74 65 73 74 20 73 6f 63 6b 65 ted}..test socke
be80: 74 2d 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 t-12.3 {testing
be90: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 inheritance of a
bea0: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d ccepted sockets}
beb0: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 \..{socket doTe
bec0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
bed0: 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 ver} {. remov
bee0: 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 eFile script1.
bef0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
bf00: 69 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 ipt2.. set f
bf10: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
bf20: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
bf30: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
bf40: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
bf50: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
bf60: 24 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f.. set f [o
bf70: 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 pen script2 w].
bf80: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
bf90: 20 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a 3a set tcltest $::
bfa0: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
bfb0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
bfc0: 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 .package req
bfd0: 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 uire tls. }.
bfe0: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
bff0: 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f \[tls::socket
c000: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
c010: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
c020: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c030: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
c040: 65 72 76 65 72 4b 65 79 20 32 39 33 30 20 5c 5d erverKey 2930 \]
c050: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
c060: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 .proc accept { f
c070: 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 ile host port }
c080: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 {.. global tc
c090: 6c 74 65 73 74 0a 09 20 20 20 20 70 75 74 73 20 ltest.. puts
c0a0: 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61 74 61 $file {test data
c0b0: 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 on socket}..
c0c0: 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 exec $::tcltest
c0d0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
c0e0: 31 20 26 0a 09 20 20 20 20 61 66 74 65 72 20 31 1 &.. after 1
c0f0: 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 76 77 61 000 exit..}..vwa
c100: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
c110: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 . close $f..
c120: 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 # Launch the
c130: 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 20 script2 process
c140: 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 and connect to i
c150: 74 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 t. See how long
c160: 0a 20 20 20 20 23 20 74 68 65 20 73 6f 63 6b 65 . # the socke
c170: 74 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 t stays open..
c180: 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 exec $::tcltes
c190: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
c1a0: 74 32 20 26 0a 0a 20 20 20 20 61 66 74 65 72 20 t2 &.. after
c1b0: 31 30 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 1000 set ok_to_p
c1c0: 72 6f 63 65 65 64 20 31 0a 20 20 20 20 76 77 61 roceed 1. vwa
c1d0: 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 it ok_to_proceed
c1e0: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 .. set f [tls
c1f0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
c200: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
c210: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
c220: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
c230: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
c240: 20 31 32 37 2e 30 2e 30 2e 31 20 32 39 33 30 5d 127.0.0.1 2930]
c250: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
c260: 24 66 20 2d 62 75 66 66 65 72 69 6e 67 20 66 75 $f -buffering fu
c270: 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 ll -blocking 0.
c280: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 66 20 fileevent $f
c290: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 readable [list g
c2a0: 65 74 64 61 74 61 20 24 66 5d 0a 0a 20 20 20 20 etdata $f]..
c2b0: 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 # If the socket
c2c0: 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 66 is still open af
c2d0: 74 65 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 ter 5 seconds, t
c2e0: 68 65 20 73 63 72 69 70 74 31 20 70 72 6f 63 65 he script1 proce
c2f0: 73 73 0a 20 20 20 20 23 20 6d 75 73 74 20 68 61 ss. # must ha
c300: 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 ve inherited the
c310: 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 accepted socket
c320: 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 ... set faile
c330: 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 d 0. after 50
c340: 30 30 20 73 65 74 20 66 61 69 6c 65 64 20 31 0a 00 set failed 1.
c350: 0a 20 20 20 20 70 72 6f 63 20 67 65 74 64 61 74 . proc getdat
c360: 61 20 7b 20 66 69 6c 65 20 7d 20 7b 0a 0a 09 23 a { file } {...#
c370: 20 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e Read handler on
c380: 20 74 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b the client sock
c390: 65 74 2e 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 67 et...global x..g
c3a0: 6c 6f 62 61 6c 20 66 61 69 6c 65 64 0a 09 73 65 lobal failed..se
c3b0: 74 20 73 74 61 74 75 73 20 5b 63 61 74 63 68 20 t status [catch
c3c0: 7b 72 65 61 64 20 24 66 69 6c 65 7d 20 64 61 74 {read $file} dat
c3d0: 61 5d 0a 09 69 66 20 7b 24 73 74 61 74 75 73 20 a]..if {$status
c3e0: 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 73 65 74 != 0} {.. set
c3f0: 20 78 20 7b 72 65 61 64 20 66 61 69 6c 65 64 2c x {read failed,
c400: 20 65 72 72 6f 72 20 77 61 73 20 24 64 61 74 61 error was $data
c410: 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 }.. catch { c
c420: 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 lose $file }..}
c430: 65 6c 73 65 69 66 20 7b 5b 73 74 72 69 6e 67 20 elseif {[string
c440: 63 6f 6d 70 61 72 65 20 7b 7d 20 24 64 61 74 61 compare {} $data
c450: 5d 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b ]} {..} elseif {
c460: 5b 66 62 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d [fblocked $file]
c470: 7d 20 7b 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b } {..} elseif {[
c480: 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 eof $file]} {..
c490: 20 20 20 69 66 20 7b 24 66 61 69 6c 65 64 7d 20 if {$failed}
c4a0: 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 63 65 70 {...set x {accep
c4b0: 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 69 ted socket was i
c4c0: 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d nherited}.. }
c4d0: 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 20 78 20 else {...set x
c4e0: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
c4f0: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
c500: 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 ed}.. }..
c510: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
c520: 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a ile }..} else {.
c530: 09 20 20 20 20 73 65 74 20 78 20 7b 69 6d 70 6f . set x {impo
c540: 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 20 20 ssible case}..
c550: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
c560: 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 74 75 $file }..}..retu
c570: 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 0a 20 20 rn. }. .
c580: 20 20 76 77 61 69 74 20 78 0a 0a 20 20 20 20 72 vwait x.. r
c590: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
c5a0: 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 1. removeFile
c5b0: 20 73 63 72 69 70 74 32 0a 20 20 20 20 73 65 74 script2. set
c5c0: 20 78 0a 7d 20 7b 61 63 63 65 70 74 65 64 20 73 x.} {accepted s
c5d0: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
c5e0: 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 73 herited}..test s
c5f0: 6f 63 6b 65 74 2d 31 33 2e 31 20 7b 54 65 73 74 ocket-13.1 {Test
c600: 69 6e 67 20 75 73 65 20 6f 66 20 73 68 61 72 65 ing use of share
c610: 64 20 73 6f 63 6b 65 74 20 62 65 74 77 65 65 6e d socket between
c620: 20 74 77 6f 20 74 68 72 65 61 64 73 7d 20 5c 0a two threads} \.
c630: 09 7b 73 6f 63 6b 65 74 20 74 65 73 74 74 68 72 .{socket testthr
c640: 65 61 64 7d 20 7b 0a 0a 20 20 20 20 72 65 6d 6f ead} {.. remo
c650: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
c660: 20 20 74 68 72 65 61 64 52 65 61 70 0a 0a 20 20 threadReap..
c670: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 makeFile {.
c680: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
c690: 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c e tls..set f [tl
c6a0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
c6b0: 72 20 61 63 63 65 70 74 20 32 38 32 38 5d 0a 09 r accept 2828]..
c6c0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
c6d0: 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 p} {.
c6e0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
c6f0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
c700: 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ho $s].
c710: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
c720: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
c730: 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 . }..proc
c740: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
c750: 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 global i.
c760: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
c770: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
c780: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
c790: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
c7a0: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
c7b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c7c0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
c7d0: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
c7e0: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
c7f0: 20 20 7d 20 65 6c 73 65 20 7b 20 0a 09 20 20 20 } else { ..
c800: 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 incr i.
c810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 pu
c820: 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 ts $s $l.
c830: 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 }..}..set
c840: 69 20 30 0a 09 76 77 61 69 74 20 78 0a 09 63 6c i 0..vwait x..cl
c850: 6f 73 65 20 24 66 0a 0a 09 23 20 74 68 72 65 61 ose $f...# threa
c860: 64 20 63 6c 65 61 6e 73 20 69 74 73 65 6c 66 20 d cleans itself
c870: 75 70 2e 0a 09 74 65 73 74 74 68 72 65 61 64 20 up...testthread
c880: 65 78 69 74 0a 20 20 20 20 7d 20 73 63 72 69 70 exit. } scrip
c890: 74 0a 20 20 20 20 0a 20 20 20 20 23 20 63 72 65 t. . # cre
c8a0: 61 74 65 20 61 20 74 68 72 65 61 64 0a 20 20 20 ate a thread.
c8b0: 20 73 65 74 20 73 65 72 76 65 72 74 68 72 65 61 set serverthrea
c8c0: 64 20 5b 74 65 73 74 74 68 72 65 61 64 20 63 72 d [testthread cr
c8d0: 65 61 74 65 20 7b 20 73 6f 75 72 63 65 20 73 63 eate { source sc
c8e0: 72 69 70 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 ript } ]. upd
c8f0: 61 74 65 0a 20 20 20 20 0a 20 20 20 20 61 66 74 ate. . aft
c900: 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 20 er 1000. set
c910: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 s [tls::socket 1
c920: 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 27.0.0.1 2828].
c930: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
c940: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
c950: 0a 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 70 .. catch {..p
c960: 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 22 0a 09 uts $s "hello"..
c970: 67 65 74 73 20 24 73 20 72 65 73 75 6c 74 0a 20 gets $s result.
c980: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
c990: 73 0a 20 20 20 20 75 70 64 61 74 65 0a 0a 20 20 s. update..
c9a0: 20 20 61 66 74 65 72 20 32 30 30 30 0a 20 20 20 after 2000.
c9b0: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
c9c0: 5b 74 68 72 65 61 64 52 65 61 70 5d 0a 20 20 20 [threadReap].
c9d0: 20 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 . set result
c9e0: 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 23 ..} {hello 1}..#
c9f0: 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b 5b 73 74 cleanup.if {[st
ca00: 72 69 6e 67 20 6d 61 74 63 68 20 73 6f 63 6b 2a ring match sock*
ca10: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d $commandSocket]
ca20: 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 75 74 73 == 1} {. puts
ca30: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
ca40: 65 78 69 74 0a 20 20 20 66 6c 75 73 68 20 24 63 exit. flush $c
ca50: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a 7d 0a 63 ommandSocket.}.c
ca60: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f 6d atch {close $com
ca70: 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 61 74 63 mandSocket}.catc
ca80: 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d 6f 74 65 h {close $remote
ca90: 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 63 6c 74 ProcChan}.::tclt
caa0: 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 65 73 74 est::cleanupTest
cab0: 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 72 s.flush stdout.r
cac0: 65 74 75 72 6e 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a 0a eturn...........
cad0: 0a .