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 4f 2e 74 65 73 74 2c 76 20 31 : tlsIO.test,v 1
0200: 2e 37 20 32 30 30 30 2f 30 36 2f 30 36 20 30 30 .7 2000/06/06 00
0210: 3a 34 38 3a 34 31 20 61 62 6f 72 72 20 45 78 70 :48:41 aborr Exp
0220: 20 24 0a 0a 23 20 52 75 6e 6e 69 6e 67 20 73 6f $..# Running so
0230: 63 6b 65 74 20 74 65 73 74 73 20 77 69 74 68 20 cket tests with
0240: 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 3a a remote server:
0250: 0a 23 20 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 2d 2d 0a 23 20 -------------.#
0280: 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 69 6e .# Some tests in
0290: 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 64 65 70 socket.test dep
02a0: 65 6e 64 20 6f 6e 20 74 68 65 20 65 78 69 73 74 end on the exist
02b0: 65 6e 63 65 20 6f 66 20 61 20 72 65 6d 6f 74 65 ence of a remote
02c0: 20 73 65 72 76 65 72 20 74 6f 0a 23 20 77 68 69 server to.# whi
02d0: 63 68 20 74 68 65 79 20 63 6f 6e 6e 65 63 74 2e ch they connect.
02e0: 20 54 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 The remote serv
02f0: 65 72 20 6d 75 73 74 20 62 65 20 61 6e 20 69 6e er must be an in
0300: 73 74 61 6e 63 65 20 6f 66 20 74 63 6c 74 65 73 stance of tcltes
0310: 74 20 61 6e 64 20 69 74 0a 23 20 6d 75 73 74 20 t and it.# must
0320: 72 75 6e 20 74 68 65 20 73 63 72 69 70 74 20 66 run the script f
0330: 6f 75 6e 64 20 69 6e 20 74 68 65 20 66 69 6c 65 ound in the file
0340: 20 22 72 65 6d 6f 74 65 2e 74 63 6c 22 20 69 6e "remote.tcl" in
0350: 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 2e this directory.
0360: 20 59 6f 75 0a 23 20 63 61 6e 20 73 74 61 72 74 You.# can start
0370: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
0380: 65 72 20 6f 6e 20 61 6e 79 20 6d 61 63 68 69 6e er on any machin
0390: 65 20 72 65 61 63 68 61 62 6c 65 20 66 72 6f 6d e reachable from
03a0: 20 74 68 65 20 6d 61 63 68 69 6e 65 20 6f 6e 0a the machine on.
03b0: 23 20 77 68 69 63 68 20 79 6f 75 20 77 61 6e 74 # which you want
03c0: 20 74 6f 20 72 75 6e 20 74 68 65 20 73 6f 63 6b to run the sock
03d0: 65 74 20 74 65 73 74 73 2c 20 62 79 20 69 73 73 et tests, by iss
03e0: 75 69 6e 67 3a 0a 23 20 0a 23 20 20 20 20 20 74 uing:.# .# t
03f0: 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 cltest remote.tc
0400: 6c 20 2d 70 6f 72 74 20 32 30 34 38 09 23 20 4f l -port 2048.# O
0410: 72 20 63 68 6f 6f 73 65 20 61 6e 6f 74 68 65 72 r choose another
0420: 20 70 6f 72 74 20 6e 75 6d 62 65 72 2e 0a 23 20 port number..#
0430: 0a 23 20 49 66 20 74 68 65 20 6d 61 63 68 69 6e .# If the machin
0440: 65 20 79 6f 75 20 61 72 65 20 72 75 6e 6e 69 6e e you are runnin
0450: 67 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 g the remote ser
0460: 76 65 72 20 6f 6e 20 68 61 73 20 73 65 76 65 72 ver on has sever
0470: 61 6c 20 49 50 0a 23 20 69 6e 74 65 72 66 61 63 al IP.# interfac
0480: 65 73 2c 20 79 6f 75 20 63 61 6e 20 63 68 6f 6f es, you can choo
0490: 73 65 20 77 68 69 63 68 20 69 6e 74 65 72 66 61 se which interfa
04a0: 63 65 20 74 68 65 20 73 65 72 76 65 72 20 6c 69 ce the server li
04b0: 73 74 65 6e 73 20 6f 6e 20 66 6f 72 0a 23 20 63 stens on for.# c
04c0: 6f 6e 6e 65 63 74 69 6f 6e 73 20 62 79 20 73 70 onnections by sp
04d0: 65 63 69 66 79 69 6e 67 20 74 68 65 20 2d 61 64 ecifying the -ad
04e0: 64 72 65 73 73 20 63 6f 6d 6d 61 6e 64 20 6c 69 dress command li
04f0: 6e 65 20 66 6c 61 67 2c 20 73 6f 3a 0a 23 20 0a ne flag, so:.# .
0500: 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 # tcltest re
0510: 6d 6f 74 65 2e 74 63 6c 20 2d 61 64 64 72 65 73 mote.tcl -addres
0520: 73 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 s your.machine.c
0530: 6f 6d 0a 23 20 0a 23 20 54 68 65 73 65 20 6f 70 om.# .# These op
0540: 74 69 6f 6e 73 20 63 61 6e 20 61 6c 73 6f 20 62 tions can also b
0550: 65 20 73 65 74 20 62 79 20 65 6e 76 69 72 6f 6e e set by environ
0560: 6d 65 6e 74 20 76 61 72 69 61 62 6c 65 73 2e 20 ment variables.
0570: 4f 6e 20 55 6e 69 78 2c 20 79 6f 75 20 63 61 6e On Unix, you can
0580: 0a 23 20 74 79 70 65 20 74 68 65 73 65 20 63 6f .# type these co
0590: 6d 6d 61 6e 64 73 20 74 6f 20 74 68 65 20 73 68 mmands to the sh
05a0: 65 6c 6c 20 66 72 6f 6d 20 77 68 69 63 68 20 74 ell from which t
05b0: 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 he remote server
05c0: 20 69 73 20 73 74 61 72 74 65 64 3a 0a 23 20 0a is started:.# .
05d0: 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 65 74 # shell% set
05e0: 65 6e 76 20 73 65 72 76 65 72 50 6f 72 74 20 32 env serverPort 2
05f0: 30 34 38 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 048.# shell%
0600: 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 41 64 setenv serverAd
0610: 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 68 69 dress your.machi
0620: 6e 65 2e 63 6f 6d 0a 23 20 0a 23 20 61 6e 64 20 ne.com.# .# and
0630: 73 75 62 73 65 71 75 65 6e 74 6c 79 20 79 6f 75 subsequently you
0640: 20 63 61 6e 20 73 74 61 72 74 20 74 68 65 20 72 can start the r
0650: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 77 69 74 emote server wit
0660: 68 3a 0a 23 20 0a 23 20 20 20 20 20 74 63 6c 74 h:.# .# tclt
0670: 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 0a 23 est remote.tcl.#
0680: 20 0a 23 20 74 6f 20 68 61 76 65 20 69 74 20 6c .# to have it l
0690: 69 73 74 65 6e 20 6f 6e 20 70 6f 72 74 20 32 30 isten on port 20
06a0: 34 38 20 6f 6e 20 74 68 65 20 69 6e 74 65 72 66 48 on the interf
06b0: 61 63 65 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 ace your.machine
06c0: 2e 63 6f 6d 2e 0a 23 20 20 20 20 20 0a 23 20 57 .com..# .# W
06d0: 68 65 6e 20 74 68 65 20 73 65 72 76 65 72 20 73 hen the server s
06e0: 74 61 72 74 73 2c 20 69 74 20 70 72 69 6e 74 73 tarts, it prints
06f0: 20 6f 75 74 20 61 20 64 65 74 61 69 6c 65 64 20 out a detailed
0700: 6d 65 73 73 61 67 65 20 63 6f 6e 74 61 69 6e 69 message containi
0710: 6e 67 20 69 74 73 0a 23 20 63 6f 6e 66 69 67 75 ng its.# configu
0720: 72 61 74 69 6f 6e 20 69 6e 66 6f 72 6d 61 74 69 ration informati
0730: 6f 6e 2c 20 61 6e 64 20 69 74 20 77 69 6c 6c 20 on, and it will
0740: 62 6c 6f 63 6b 20 75 6e 74 69 6c 20 6b 69 6c 6c block until kill
0750: 65 64 20 77 69 74 68 20 61 20 43 74 72 6c 2d 43 ed with a Ctrl-C
0760: 2e 0a 23 20 4f 6e 63 65 20 74 68 65 20 72 65 6d ..# Once the rem
0770: 6f 74 65 20 73 65 72 76 65 72 20 65 78 69 73 74 ote server exist
0780: 73 2c 20 79 6f 75 20 63 61 6e 20 72 75 6e 20 74 s, you can run t
0790: 68 65 20 74 65 73 74 73 20 69 6e 20 73 6f 63 6b he tests in sock
07a0: 65 74 2e 74 65 73 74 20 77 69 74 68 0a 23 20 74 et.test with.# t
07b0: 68 65 20 73 65 72 76 65 72 20 62 79 20 73 65 74 he server by set
07c0: 74 69 6e 67 20 74 77 6f 20 54 63 6c 20 76 61 72 ting two Tcl var
07d0: 69 61 62 6c 65 73 3a 0a 23 20 0a 23 20 20 20 20 iables:.# .#
07e0: 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 % set remoteSer
07f0: 76 65 72 49 50 20 3c 6e 61 6d 65 20 6f 72 20 61 verIP <name or a
0800: 64 64 72 65 73 73 20 6f 66 20 6d 61 63 68 69 6e ddress of machin
0810: 65 20 6f 6e 20 77 68 69 63 68 20 73 65 72 76 65 e on which serve
0820: 72 20 72 75 6e 73 3e 0a 23 20 20 20 20 20 25 20 r runs>.# %
0830: 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 set remoteServer
0840: 50 6f 72 74 20 32 30 34 38 0a 23 20 0a 23 20 54 Port 2048.# .# T
0850: 68 65 73 65 20 76 61 72 69 61 62 6c 65 73 20 61 hese variables a
0860: 72 65 20 61 6c 73 6f 20 73 65 74 74 61 62 6c 65 re also settable
0870: 20 66 72 6f 6d 20 74 68 65 20 65 6e 76 69 72 6f from the enviro
0880: 6e 6d 65 6e 74 2e 20 4f 6e 20 55 6e 69 78 2c 20 nment. On Unix,
0890: 79 6f 75 20 63 61 6e 3a 0a 23 20 0a 23 20 20 20 you can:.# .#
08a0: 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 shell% setenv
08b0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 6d remoteServerIP m
08c0: 61 63 68 69 6e 65 2e 77 68 65 72 65 2e 73 65 72 achine.where.ser
08d0: 76 65 72 2e 72 75 6e 73 0a 23 20 20 20 20 20 73 ver.runs.# s
08e0: 68 65 6c 6c 25 20 73 65 6e 65 74 76 20 72 65 6d hell% senetv rem
08f0: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 32 30 oteServerPort 20
0900: 34 38 0a 23 20 0a 23 20 54 68 65 20 70 72 65 61 48.# .# The prea
0910: 6d 62 6c 65 20 6f 66 20 74 68 65 20 73 6f 63 6b mble of the sock
0920: 65 74 2e 74 65 73 74 20 66 69 6c 65 20 63 68 65 et.test file che
0930: 63 6b 73 20 74 6f 20 73 65 65 20 69 66 20 74 68 cks to see if th
0940: 65 20 76 61 72 69 61 62 6c 65 73 20 61 72 65 20 e variables are
0950: 73 65 74 0a 23 20 65 69 74 68 65 72 20 69 6e 20 set.# either in
0960: 54 63 6c 20 6f 72 20 69 6e 20 74 68 65 20 65 6e Tcl or in the en
0970: 76 69 72 6f 6e 6d 65 6e 74 3b 20 69 66 20 74 68 vironment; if th
0980: 65 79 20 61 72 65 2c 20 69 74 20 61 74 74 65 6d ey are, it attem
0990: 70 74 73 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 pts to connect t
09a0: 6f 0a 23 20 74 68 65 20 73 65 72 76 65 72 2e 20 o.# the server.
09b0: 49 66 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f If the connectio
09c0: 6e 20 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c n is successful,
09d0: 20 74 68 65 20 74 65 73 74 73 20 75 73 69 6e 67 the tests using
09e0: 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 the remote.# se
09f0: 72 76 65 72 20 77 69 6c 6c 20 62 65 20 70 65 72 rver will be per
0a00: 66 6f 72 6d 65 64 3b 20 6f 74 68 65 72 77 69 73 formed; otherwis
0a10: 65 2c 20 69 74 20 77 69 6c 6c 20 61 74 74 65 6d e, it will attem
0a20: 70 74 20 74 6f 20 73 74 61 72 74 20 74 68 65 20 pt to start the
0a30: 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 20 remote.# server
0a40: 28 76 69 61 20 65 78 65 63 29 20 6f 6e 20 70 6c (via exec) on pl
0a50: 61 74 66 6f 72 6d 73 20 74 68 61 74 20 73 75 70 atforms that sup
0a60: 70 6f 72 74 20 74 68 69 73 2c 20 6f 6e 20 74 68 port this, on th
0a70: 65 20 6c 6f 63 61 6c 20 68 6f 73 74 2c 0a 23 20 e local host,.#
0a80: 6c 69 73 74 65 6e 69 6e 67 20 61 74 20 70 6f 72 listening at por
0a90: 74 20 32 30 34 38 2e 20 49 66 20 61 6c 6c 20 66 t 2048. If all f
0aa0: 61 69 6c 73 2c 20 61 20 6d 65 73 73 61 67 65 20 ails, a message
0ab0: 69 73 20 70 72 69 6e 74 65 64 20 61 6e 64 20 74 is printed and t
0ac0: 68 65 20 74 65 73 74 73 0a 23 20 75 73 69 6e 67 he tests.# using
0ad0: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
0ae0: 65 72 20 61 72 65 20 6e 6f 74 20 70 65 72 66 6f er are not perfo
0af0: 72 6d 65 64 2e 0a 0a 69 66 20 7b 5b 6c 73 65 61 rmed...if {[lsea
0b00: 72 63 68 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 rch [namespace c
0b10: 68 69 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c 74 65 hildren] ::tclte
0b20: 73 74 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 20 20 st] == -1} {.
0b30: 20 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 package require
0b40: 20 74 63 6c 74 65 73 74 0a 20 20 20 20 6e 61 6d tcltest. nam
0b50: 65 73 70 61 63 65 20 69 6d 70 6f 72 74 20 2d 66 espace import -f
0b60: 6f 72 63 65 20 3a 3a 74 63 6c 74 65 73 74 3a 3a orce ::tcltest::
0b70: 2a 0a 7d 0a 0a 23 20 4c 6f 61 64 20 74 68 65 20 *.}..# Load the
0b80: 74 6c 73 20 70 61 63 6b 61 67 65 0a 70 61 63 6b tls package.pack
0b90: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
0ba0: 0a 73 65 74 20 63 65 72 74 73 44 69 72 20 5b 66 .set certsDir [f
0bb0: 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 ile join [file d
0bc0: 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 73 63 72 irname [info scr
0bd0: 69 70 74 5d 5d 20 63 65 72 74 73 5d 20 0a 0a 73 ipt]] certs] ..s
0be0: 65 74 20 73 65 72 76 65 72 43 65 72 74 20 5b 66 et serverCert [f
0bf0: 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 ile join $certsD
0c00: 69 72 20 73 65 72 76 65 72 2e 70 65 6d 5d 0a 73 ir server.pem].s
0c10: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 5b 66 et clientCert [f
0c20: 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 ile join $certsD
0c30: 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 ir client.pem].s
0c40: 65 74 20 63 61 43 65 72 74 20 5b 66 69 6c 65 20 et caCert [file
0c50: 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 join $certsDir c
0c60: 61 63 65 72 74 2e 70 65 6d 5d 0a 73 65 74 20 73 acert.pem].set s
0c70: 65 72 76 65 72 4b 65 79 20 5b 66 69 6c 65 20 6a erverKey [file j
0c80: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 6b oin $certsDir sk
0c90: 65 79 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 ey.pem].set clie
0ca0: 6e 74 4b 65 79 20 5b 66 69 6c 65 20 6a 6f 69 6e ntKey [file join
0cb0: 20 24 63 65 72 74 73 44 69 72 20 63 6b 65 79 2e $certsDir ckey.
0cc0: 70 65 6d 5d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 pem]..# Some tes
0cd0: 74 73 20 72 65 71 75 69 72 65 20 74 68 65 20 74 ts require the t
0ce0: 65 73 74 74 68 72 65 61 64 20 63 6f 6d 6d 61 6e estthread comman
0cf0: 64 0a 0a 73 65 74 20 3a 3a 74 63 6c 74 65 73 74 d..set ::tcltest
0d00: 3a 3a 74 65 73 74 43 6f 6e 73 74 72 61 69 6e 74 ::testConstraint
0d10: 73 28 74 65 73 74 74 68 72 65 61 64 29 20 5c 0a s(testthread) \.
0d20: 09 5b 65 78 70 72 20 7b 5b 69 6e 66 6f 20 63 6f .[expr {[info co
0d30: 6d 6d 61 6e 64 73 20 74 65 73 74 74 68 72 65 61 mmands testthrea
0d40: 64 5d 20 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 d] != {}}]..#.#
0d50: 49 66 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 If remoteServerI
0d60: 50 20 6f 72 20 72 65 6d 6f 74 65 53 65 72 76 65 P or remoteServe
0d70: 72 50 6f 72 74 20 61 72 65 20 6e 6f 74 20 73 65 rPort are not se
0d80: 74 2c 20 63 68 65 63 6b 20 69 6e 20 74 68 65 0a t, check in the.
0d90: 23 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 # environment va
0da0: 72 69 61 62 6c 65 73 20 66 6f 72 20 65 78 74 65 riables for exte
0db0: 72 6e 61 6c 6c 79 20 73 65 74 20 76 61 6c 75 65 rnally set value
0dc0: 73 2e 0a 23 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f s..#..if {![info
0dd0: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 exists remoteSe
0de0: 72 76 65 72 49 50 5d 7d 20 7b 0a 20 20 20 20 69 rverIP]} {. i
0df0: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0e00: 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 65 72 env(remoteServer
0e10: 49 50 29 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d IP)]} {..set rem
0e20: 6f 74 65 53 65 72 76 65 72 49 50 20 24 65 6e 76 oteServerIP $env
0e30: 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 (remoteServerIP)
0e40: 0a 20 20 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 . }.}.if {![i
0e50: 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 nfo exists remot
0e60: 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a eServerPort]} {.
0e70: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
0e80: 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 ists env(remoteS
0e90: 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 erverIP)]} {..se
0ea0: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f t remoteServerPo
0eb0: 72 74 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 rt $env(remoteSe
0ec0: 72 76 65 72 50 6f 72 74 29 0a 20 20 20 20 7d 20 rverPort). }
0ed0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 69 else {. i
0ee0: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 f {[info exists
0ef0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 7d remoteServerIP]}
0f00: 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f {.. set remo
0f10: 74 65 53 65 72 76 65 72 50 6f 72 74 20 32 30 34 teServerPort 204
0f20: 38 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 8. }.
0f30: 7d 0a 7d 0a 0a 23 0a 23 20 43 68 65 63 6b 20 69 }.}..#.# Check i
0f40: 66 20 77 65 27 72 65 20 73 75 70 70 6f 73 65 64 f we're supposed
0f50: 20 74 6f 20 64 6f 20 74 65 73 74 73 20 61 67 61 to do tests aga
0f60: 69 6e 73 74 20 74 68 65 20 72 65 6d 6f 74 65 20 inst the remote
0f70: 73 65 72 76 65 72 0a 23 0a 0a 73 65 74 20 64 6f server.#..set do
0f80: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
0f90: 65 72 76 65 72 20 31 0a 69 66 20 7b 21 5b 69 6e erver 1.if {![in
0fa0: 66 6f 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 fo exists remote
0fb0: 53 65 72 76 65 72 49 50 5d 20 26 26 20 28 24 74 ServerIP] && ($t
0fc0: 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 cl_platform(plat
0fd0: 66 6f 72 6d 29 20 21 3d 20 22 6d 61 63 69 6e 74 form) != "macint
0fe0: 6f 73 68 22 29 7d 20 7b 0a 20 20 20 20 73 65 74 osh")} {. set
0ff0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
1000: 31 32 37 2e 30 2e 30 2e 31 0a 7d 0a 69 66 20 7b 127.0.0.1.}.if {
1010: 28 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d ($doTestsWithRem
1020: 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 29 20 oteServer == 1)
1030: 26 26 20 28 21 5b 69 6e 66 6f 20 65 78 69 73 74 && (![info exist
1040: 73 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f s remoteServerPo
1050: 72 74 5d 29 7d 20 7b 0a 20 20 20 20 73 65 74 20 rt])} {. set
1060: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
1070: 20 32 30 34 38 0a 7d 0a 0a 23 20 41 74 74 65 6d 2048.}..# Attem
1080: 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f pt to connect to
1090: 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 a remote server
10a0: 20 69 66 20 6f 6e 65 20 69 73 20 61 6c 72 65 61 if one is alrea
10b0: 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 66 20 69 dy running. If i
10c0: 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 6e 6e 69 t.# is not runni
10d0: 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d 65 20 6f ng or for some o
10e0: 74 68 65 72 20 72 65 61 73 6f 6e 20 74 68 65 20 ther reason the
10f0: 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 2c 20 61 connect fails, a
1100: 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 74 61 72 ttempt to.# star
1110: 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 t the remote ser
1120: 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c ver on the local
1130: 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 6e 67 20 host listening
1140: 6f 6e 20 70 6f 72 74 20 32 30 34 38 2e 20 54 68 on port 2048. Th
1150: 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 64 6f 6e is.# is only don
1160: 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 e on platforms t
1170: 68 61 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 hat support exec
1180: 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 68 (i.e. not on th
1190: 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 70 6c 61 e Mac). On.# pla
11a0: 74 66 6f 72 6d 73 20 74 68 61 74 20 64 6f 20 6e tforms that do n
11b0: 6f 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 2c ot support exec,
11c0: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
11d0: 65 72 20 6d 75 73 74 20 62 65 20 73 74 61 72 74 er must be start
11e0: 65 64 0a 23 20 62 79 20 74 68 65 20 75 73 65 72 ed.# by the user
11f0: 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 before running
1200: 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 65 74 20 the tests...set
1210: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 22 remoteProcChan "
1220: 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 ".set commandSoc
1230: 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 6f 54 65 ket "".if {$doTe
1240: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1250: 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 74 63 68 ver} {. catch
1260: 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 {close $command
1270: 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 66 20 7b Socket}. if {
1280: 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d [catch {set comm
1290: 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a andSocket [tls::
12a0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
12b0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
12c0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
12d0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
12e0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
12f0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 5c remoteServerIP \
1300: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
1310: 76 65 72 50 6f 72 74 5d 7d 5d 20 21 3d 20 30 7d verPort]}] != 0}
1320: 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 63 6f {..if {[info co
1330: 6d 6d 61 6e 64 73 20 65 78 65 63 5d 20 3d 3d 20 mmands exec] ==
1340: 22 22 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6e ""} {.. set n
1350: 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f oRemoteTestReaso
1360: 6e 20 22 63 61 6e 27 74 20 65 78 65 63 22 0a 09 n "can't exec"..
1370: 20 20 20 20 73 65 74 20 64 6f 54 65 73 74 73 57 set doTestsW
1380: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
1390: 30 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 0..} else {..
13a0: 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 set remoteServe
13b0: 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 09 20 rIP 127.0.0.1..
13c0: 20 20 20 73 65 74 20 72 65 6d 6f 74 65 46 69 6c set remoteFil
13d0: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
13e0: 64 5d 20 72 65 6d 6f 74 65 2e 74 63 6c 5d 0a 09 d] remote.tcl]..
13f0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
1400: 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 68 set remoteProcCh
1410: 61 6e 20 5c 0a 09 09 09 09 5b 6f 70 65 6e 20 22 an \.....[open "
1420: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
1430: 74 3a 3a 74 63 6c 74 65 73 74 20 24 72 65 6d 6f t::tcltest $remo
1440: 74 65 46 69 6c 65 20 5c 0a 09 09 09 09 09 2d 73 teFile \......-s
1450: 65 72 76 65 72 49 73 53 69 6c 65 6e 74 20 5c 0a erverIsSilent \.
1460: 09 09 09 09 09 2d 70 6f 72 74 20 24 72 65 6d 6f .....-port $remo
1470: 74 65 53 65 72 76 65 72 50 6f 72 74 20 5c 0a 09 teServerPort \..
1480: 09 09 09 09 2d 61 64 64 72 65 73 73 20 24 72 65 ....-address $re
1490: 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 22 20 5c moteServerIP]" \
14a0: 0a 09 09 09 09 09 77 2b 5d 7d 20 5c 0a 09 09 20 ......w+]} \...
14b0: 20 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 msg] == 0} {..
14c0: 09 61 66 74 65 72 20 31 30 30 30 0a 09 09 69 66 .after 1000...if
14d0: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f {[catch {set co
14e0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 mmandSocket [tls
14f0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 20 20 20 ::socket \...
1500: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
1510: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
1520: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
1530: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 09 09 $clientKey \....
1540: 09 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 .$remoteServerIP
1550: 20 5c 0a 09 09 09 09 24 72 65 6d 6f 74 65 53 65 \.....$remoteSe
1560: 72 76 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 20 rverPort]} msg]
1570: 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 20 66 63 == 0} {... fc
1580: 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e onfigure $comman
1590: 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 dSocket -transla
15a0: 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 tion crlf -buffe
15b0: 72 69 6e 67 20 6c 69 6e 65 0a 09 09 7d 20 65 6c ring line...} el
15c0: 73 65 20 7b 0a 09 09 20 20 20 20 73 65 74 20 6e se {... set n
15d0: 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f oRemoteTestReaso
15e0: 6e 20 24 6d 73 67 0a 09 09 20 20 20 20 73 65 74 n $msg... set
15f0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
1600: 74 65 53 65 72 76 65 72 20 30 0a 09 09 7d 0a 09 teServer 0...}..
1610: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 } else {...s
1620: 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 et noRemoteTestR
1630: 65 61 73 6f 6e 20 22 24 6d 73 67 20 24 3a 3a 74 eason "$msg $::t
1640: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 22 cltest::tcltest"
1650: 0a 09 09 73 65 74 20 64 6f 54 65 73 74 73 57 69 ...set doTestsWi
1660: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 thRemoteServer 0
1670: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
1680: 20 65 6c 73 65 20 7b 0a 09 66 63 6f 6e 66 69 67 else {..fconfig
1690: 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ure $commandSock
16a0: 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 et -translation
16b0: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
16c0: 6c 69 6e 65 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 line. }.}..#
16d0: 53 6f 6d 65 20 74 65 73 74 73 20 61 72 65 20 72 Some tests are r
16e0: 75 6e 20 6f 6e 6c 79 20 69 66 20 77 65 20 61 72 un only if we ar
16f0: 65 20 64 6f 69 6e 67 20 74 65 73 74 69 6e 67 20 e doing testing
1700: 61 67 61 69 6e 73 74 20 61 20 72 65 6d 6f 74 65 against a remote
1710: 20 73 65 72 76 65 72 2e 0a 73 65 74 20 3a 3a 74 server..set ::t
1720: 63 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 cltest::testCons
1730: 74 72 61 69 6e 74 73 28 64 6f 54 65 73 74 73 57 traints(doTestsW
1740: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 29 ithRemoteServer)
1750: 20 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d $doTestsWithRem
1760: 6f 74 65 53 65 72 76 65 72 0a 69 66 20 7b 24 64 oteServer.if {$d
1770: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
1780: 53 65 72 76 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 Server == 0} {.
1790: 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 if {[string f
17a0: 69 72 73 74 20 73 20 24 3a 3a 74 63 6c 74 65 73 irst s $::tcltes
17b0: 74 3a 3a 76 65 72 62 6f 73 65 5d 20 21 3d 20 2d t::verbose] != -
17c0: 31 7d 20 7b 0a 20 20 20 20 09 70 75 74 73 20 22 1} {. .puts "
17d0: 53 6b 69 70 70 69 6e 67 20 74 65 73 74 73 20 77 Skipping tests w
17e0: 69 74 68 20 72 65 6d 6f 74 65 20 73 65 72 76 65 ith remote serve
17f0: 72 2e 20 53 65 65 20 74 65 73 74 73 2f 73 6f 63 r. See tests/soc
1800: 6b 65 74 2e 74 65 73 74 20 66 6f 72 22 0a 09 70 ket.test for"..p
1810: 75 74 73 20 22 69 6e 66 6f 72 6d 61 74 69 6f 6e uts "information
1820: 20 6f 6e 20 68 6f 77 20 74 6f 20 72 75 6e 20 72 on how to run r
1830: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 22 0a 09 emote server."..
1840: 70 75 74 73 20 22 52 65 61 73 6f 6e 20 66 6f 72 puts "Reason for
1850: 20 6e 6f 74 20 64 6f 69 6e 67 20 72 65 6d 6f 74 not doing remot
1860: 65 20 74 65 73 74 73 3a 20 24 6e 6f 52 65 6d 6f e tests: $noRemo
1870: 74 65 54 65 73 74 52 65 61 73 6f 6e 22 0a 20 20 teTestReason".
1880: 20 20 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 77 65 }.}..#.# If we
1890: 20 64 6f 20 74 68 65 20 74 65 73 74 73 2c 20 64 do the tests, d
18a0: 65 66 69 6e 65 20 61 20 63 6f 6d 6d 61 6e 64 20 efine a command
18b0: 74 6f 20 73 65 6e 64 20 61 20 63 6f 6d 6d 61 6e to send a comman
18c0: 64 20 74 6f 20 74 68 65 0a 23 20 72 65 6d 6f 74 d to the.# remot
18d0: 65 20 73 65 72 76 65 72 2e 0a 23 0a 0a 69 66 20 e server..#..if
18e0: 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d {$doTestsWithRem
18f0: 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 31 7d 20 oteServer == 1}
1900: 7b 0a 20 20 20 20 70 72 6f 63 20 73 65 6e 64 43 {. proc sendC
1910: 6f 6d 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 67 6c ommand {c} {..gl
1920: 6f 62 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b obal commandSock
1930: 65 74 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 24 63 et...if {[eof $c
1940: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b ommandSocket]} {
1950: 0a 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d .. error "rem
1960: 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 ote server disap
1970: 70 65 61 72 65 64 22 0a 09 7d 0a 0a 09 69 66 20 peared"..}...if
1980: 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 {[catch {puts $c
1990: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 24 63 7d ommandSocket $c}
19a0: 20 6d 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 msg]} {.. er
19b0: 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 ror "remote serv
19c0: 65 72 20 64 69 73 61 70 70 61 65 72 65 64 3a 20 er disappaered:
19d0: 24 6d 73 67 22 0a 09 7d 0a 09 69 66 20 7b 5b 63 $msg"..}..if {[c
19e0: 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d atch {puts $comm
19f0: 61 6e 64 53 6f 63 6b 65 74 20 22 2d 2d 4d 61 72 andSocket "--Mar
1a00: 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 ker--Marker--Mar
1a10: 6b 65 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 7b 0a ker--"} msg]} {.
1a20: 09 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f . error "remo
1a30: 74 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 te server disapp
1a40: 65 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a eared: $msg"..}.
1a50: 0a 09 73 65 74 20 72 65 73 70 20 22 22 0a 09 77 ..set resp ""..w
1a60: 68 69 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 20 20 hile {1} {..
1a70: 73 65 74 20 6c 69 6e 65 20 5b 67 65 74 73 20 24 set line [gets $
1a80: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 0a 09 commandSocket]..
1a90: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 63 6f if {[eof $co
1aa0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a mmandSocket]} {.
1ab0: 09 09 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 ..error "remote
1ac0: 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 72 server disappear
1ad0: 65 64 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 ed".. }..
1ae0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
1af0: 61 72 65 20 24 6c 69 6e 65 20 22 2d 2d 4d 61 72 are $line "--Mar
1b00: 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 ker--Marker--Mar
1b10: 6b 65 72 2d 2d 22 5d 20 3d 3d 20 30 7d 20 7b 0a ker--"] == 0} {.
1b20: 09 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f ..if {[string co
1b30: 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 72 mpare [lindex $r
1b40: 65 73 70 20 30 5d 20 65 72 72 6f 72 5d 20 3d 3d esp 0] error] ==
1b50: 20 30 7d 20 7b 0a 09 09 20 20 20 20 65 72 72 6f 0} {... erro
1b60: 72 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 r [lindex $resp
1b70: 31 5d 0a 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 1]...} else {...
1b80: 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 6e 64 return [lind
1b90: 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 7d 0a ex $resp 1]...}.
1ba0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
1bb0: 61 70 70 65 6e 64 20 72 65 73 70 20 24 6c 69 6e append resp $lin
1bc0: 65 20 22 5c 6e 22 0a 09 20 20 20 20 7d 0a 09 7d e "\n".. }..}
1bd0: 0a 20 20 20 20 7d 0a 7d 0a 0a 74 65 73 74 20 74 . }.}..test t
1be0: 6c 73 49 4f 2d 31 2e 31 20 7b 61 72 67 20 70 61 lsIO-1.1 {arg pa
1bf0: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
1c00: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
1c10: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
1c20: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
1c30: 74 20 2d 73 65 72 76 65 72 7d 20 6d 73 67 5d 20 t -server} msg]
1c40: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
1c50: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
1c60: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
1c70: 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 -server command
1c80: 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d ?options? port"}
1c90: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
1ca0: 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 2 {arg parsing f
1cb0: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
1cc0: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
1cd0: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
1ce0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
1cf0: 65 72 20 66 6f 6f 7d 20 6d 73 67 5d 20 24 6d 73 er foo} msg] $ms
1d00: 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 g.} {1 {wrong #
1d10: 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 args: should be
1d20: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
1d30: 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 rver command ?op
1d40: 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a tions? port"}}..
1d50: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 33 20 7b test tlsIO-1.3 {
1d60: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
1d70: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
1d80: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
1d90: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
1da0: 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 7d :socket -myaddr}
1db0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
1dc0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
1dd0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
1de0: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
1df0: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
1e00: 73 74 20 74 6c 73 49 4f 2d 31 2e 34 20 7b 61 72 st tlsIO-1.4 {ar
1e10: 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f g parsing for so
1e20: 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 cket command} {s
1e30: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 ocket} {. lis
1e40: 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 t [catch {tls::s
1e50: 6f 63 6b 65 74 20 2d 6d 79 61 64 64 72 20 31 32 ocket -myaddr 12
1e60: 37 2e 30 2e 30 2e 31 7d 20 6d 73 67 5d 20 24 6d 7.0.0.1} msg] $m
1e70: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
1e80: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
1e90: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f "tls::socket ?o
1ea0: 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 ptions? host por
1eb0: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
1ec0: 2d 31 2e 35 20 7b 61 72 67 20 70 61 72 73 69 6e -1.5 {arg parsin
1ed0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
1ee0: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
1ef0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
1f00: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
1f10: 79 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 yport} msg] $msg
1f20: 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 .} {1 {wrong # a
1f30: 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 rgs: should be "
1f40: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 tls::socket ?opt
1f50: 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 ions? host port"
1f60: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
1f70: 2e 36 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .6 {arg parsing
1f80: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
1f90: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
1fa0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
1fb0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 tls::socket -myp
1fc0: 6f 72 74 20 78 78 78 78 7d 20 6d 73 67 5d 20 24 ort xxxx} msg] $
1fd0: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
1fe0: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
1ff0: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
2000: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
2010: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2020: 4f 2d 31 2e 37 20 7b 61 72 67 20 70 61 72 73 69 O-1.7 {arg parsi
2030: 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f ng for socket co
2040: 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 mmand} {socket}
2050: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
2060: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2070: 6d 79 70 6f 72 74 20 32 35 32 32 7d 20 6d 73 67 myport 2522} msg
2080: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
2090: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
20a0: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
20b0: 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 t ?options? host
20c0: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
20d0: 6c 73 49 4f 2d 31 2e 38 20 7b 61 72 67 20 70 61 lsIO-1.8 {arg pa
20e0: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
20f0: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2100: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2110: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2120: 74 20 2d 66 72 6f 62 6f 7a 7d 20 6d 73 67 5d 20 t -froboz} msg]
2130: 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 $msg.} {1 {wrong
2140: 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 # args: should
2150: 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 be "tls::socket
2160: 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 ?options? host p
2170: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
2180: 49 4f 2d 31 2e 39 20 7b 61 72 67 20 70 61 72 73 IO-1.9 {arg pars
2190: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
21a0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
21b0: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
21c0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
21d0: 2d 73 65 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 -server foo -myp
21e0: 6f 72 74 20 32 35 32 31 20 33 33 33 33 7d 20 6d ort 2521 3333} m
21f0: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2200: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2210: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2220: 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d ket -server comm
2230: 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f and ?options? po
2240: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2250: 4f 2d 31 2e 31 30 20 7b 61 72 67 20 70 61 72 73 O-1.10 {arg pars
2260: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
2270: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
2280: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
2290: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
22a0: 68 6f 73 74 20 32 35 32 38 20 2d 6a 75 6e 6b 7d host 2528 -junk}
22b0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
22c0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
22d0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
22e0: 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 ocket ?options?
22f0: 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 host port"}}..te
2300: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 31 20 7b 61 st tlsIO-1.11 {a
2310: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2320: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2330: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2340: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2350: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 socket -server c
2360: 61 6c 6c 62 61 63 6b 20 32 35 32 30 20 2d 2d 7d allback 2520 --}
2370: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
2380: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
2390: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
23a0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f ocket -server co
23b0: 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 mmand ?options?
23c0: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
23d0: 73 49 4f 2d 31 2e 31 32 20 7b 61 72 67 20 70 61 sIO-1.12 {arg pa
23e0: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
23f0: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2400: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2410: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
2420: 74 20 66 6f 6f 20 62 61 64 70 6f 72 74 7d 20 6d t foo badport} m
2430: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 65 sg] $msg.} {1 {e
2440: 78 70 65 63 74 65 64 20 69 6e 74 65 67 65 72 20 xpected integer
2450: 62 75 74 20 67 6f 74 20 22 62 61 64 70 6f 72 74 but got "badport
2460: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
2470: 32 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 2.1 {tcp connect
2480: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ion} {socket std
2490: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
24a0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
24b0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
24c0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
24d0: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
24e0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
24f0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
2500: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
2510: 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 20 20 _out"]. }.
2520: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2530: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2540: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
2550: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
2560: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2570: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
2580: 76 65 72 4b 65 79 20 32 38 32 38 20 5c 5d 22 0a verKey 2828 \]".
2590: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
25a0: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
25b0: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 addr port} {..
25c0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
25d0: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
25e0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
25f0: 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 ile..}..puts rea
2600: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
2610: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
2620: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
2630: 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $x. }. cl
2640: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
2650: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
2660: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
2670: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
2680: 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 gets $f x.
2690: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 if {[catch {tls
26a0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
26b0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
26c0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
26d0: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
26e0: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
26f0: 32 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 2828} msg]} {.
2700: 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 set x $msg
2710: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
2720: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
2730: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
2740: 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 close $msg.
2750: 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 }. lappend x
2760: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
2770: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
2780: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 x.} {ready done
2790: 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 78 {}}..if [info ex
27a0: 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 20 ists port] {.
27b0: 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c 73 incr port.} els
27c0: 65 20 7b 20 0a 20 20 20 20 73 65 74 20 70 6f 72 e { . set por
27d0: 74 20 5b 65 78 70 72 20 32 30 34 38 20 2b 20 5b t [expr 2048 + [
27e0: 70 69 64 5d 25 31 30 32 34 5d 0a 7d 0a 0a 74 65 pid]%1024].}..te
27f0: 73 74 20 74 6c 73 49 4f 2d 32 2e 32 20 7b 74 63 st tlsIO-2.2 {tc
2800: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 p connection wit
2810: 68 20 63 6c 69 65 6e 74 20 70 6f 72 74 20 73 70 h client port sp
2820: 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 ecified} {socket
2830: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
2840: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
2850: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
2860: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
2870: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
2880: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
2890: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
28a0: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
28b0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
28c0: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
28d0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
28e0: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
28f0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
2900: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
2910: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
2920: 79 20 32 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 y 2829 \]". p
2930: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
2940: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
2950: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
2960: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
2970: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
2980: 5b 67 65 74 73 20 24 66 69 6c 65 5d 20 24 70 6f [gets $file] $po
2990: 72 74 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 rt".
29a0: 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 20 close $file.
29b0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
29c0: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
29d0: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
29e0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
29f0: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
2a00: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
2a10: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
2a20: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
2a30: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
2a40: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
2a50: 20 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 70 6f x. global po
2a60: 72 74 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 rt. if {[catc
2a70: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2a80: 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 5c 0a 09 myport $port \..
2a90: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
2aa0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
2ab0: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
2ac0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 e $clientKey 127
2ad0: 2e 30 2e 30 2e 31 20 32 38 32 39 7d 20 73 6f 63 .0.0.1 2829} soc
2ae0: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 k]} {. se
2af0: 74 20 78 20 24 73 6f 63 6b 0a 09 63 61 74 63 68 t x $sock..catch
2b00: 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 3a 3a 73 6f {close [tls::so
2b10: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
2b20: 38 32 39 5d 7d 0a 20 20 20 20 7d 20 65 6c 73 65 829]}. } else
2b30: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
2b40: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
2b50: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
2b60: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
2b70: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
2b80: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
2b90: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
2ba0: 73 65 74 20 78 0a 7d 20 5b 6c 69 73 74 20 72 65 set x.} [list re
2bb0: 61 64 79 20 22 68 65 6c 6c 6f 20 24 70 6f 72 74 ady "hello $port
2bc0: 22 5d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 "]..test tlsIO-2
2bd0: 2e 33 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .3 {tcp connecti
2be0: 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 69 on with client i
2bf0: 6e 74 65 72 66 61 63 65 20 73 70 65 63 69 66 69 nterface specifi
2c00: 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ed} {socket stdi
2c10: 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 o} {. removeF
2c20: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 ile script. s
2c30: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
2c40: 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 t w]. puts $f
2c50: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
2c60: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
2c70: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
2c80: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 set x done"].
2c90: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
2ca0: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
2cb0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
2cc0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
2cd0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
2ce0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
2cf0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 e $serverKey 283
2d00: 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 0 \]". puts $
2d10: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
2d20: 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 {file addr port
2d30: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
2d40: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
2d50: 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 puts "[gets
2d60: 20 24 66 69 6c 65 5d 20 24 61 64 64 72 22 0a 20 $file] $addr".
2d70: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
2d80: 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 20 $file.
2d90: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
2da0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
2db0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
2dc0: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
2dd0: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
2de0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
2df0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
2e00: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
2e10: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
2e20: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
2e30: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
2e40: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 s::socket -myadd
2e50: 72 20 31 32 37 2e 30 2e 30 2e 31 20 5c 0a 09 2d r 127.0.0.1 \..-
2e60: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
2e70: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
2e80: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
2e90: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
2ea0: 30 2e 30 2e 31 20 32 38 33 30 7d 20 73 6f 63 6b 0.0.1 2830} sock
2eb0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
2ec0: 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 x $sock. } e
2ed0: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 lse {. pu
2ee0: 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 ts $sock hello..
2ef0: 63 61 74 63 68 20 7b 66 6c 75 73 68 20 24 73 6f catch {flush $so
2f00: 63 6b 7d 0a 20 20 20 20 20 20 20 20 6c 61 70 70 ck}. lapp
2f10: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
2f20: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
2f30: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ock. }. cl
2f40: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
2f50: 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 6c 6c 6f .} {ready {hello
2f60: 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 127.0.0.1}}..te
2f70: 73 74 20 74 6c 73 49 4f 2d 32 2e 34 20 7b 74 63 st tlsIO-2.4 {tc
2f80: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 p connection wit
2f90: 68 20 73 65 72 76 65 72 20 69 6e 74 65 72 66 61 h server interfa
2fa0: 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 ce specified} {s
2fb0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
2fc0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
2fd0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
2fe0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
2ff0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
3000: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
3010: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
3020: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
3030: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
3040: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3050: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3060: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
3070: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3080: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3090: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
30a0: 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 5b verKey -myaddr [
30b0: 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 info hostname] 2
30c0: 38 33 31 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 831 \]". puts
30d0: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
30e0: 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 6f pt {file addr po
30f0: 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 rt} {.
3100: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
3110: 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 puts "[ge
3120: 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 20 20 20 ts $file]".
3130: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 close $fi
3140: 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 le. s
3150: 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 et x done..}..pu
3160: 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 ts ready..vwait
3170: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
3180: 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 $timer..close $f
3190: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
31a0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
31b0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
31c0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
31d0: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
31e0: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
31f0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
3200: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
3210: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
3220: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
3230: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
3240: 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d ey [info hostnam
3250: 65 5d 20 32 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 e] 2831} sock]}
3260: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
3270: 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 $sock. } else
3280: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
3290: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
32a0: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
32b0: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
32c0: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
32d0: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
32e0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
32f0: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 set x.} {ready h
3300: 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ello}..test tlsI
3310: 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 O-2.5 {tcp conne
3320: 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e ction with redun
3330: 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 dant server port
3340: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
3350: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
3360: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
3370: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3380: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
3390: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
33a0: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
33b0: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
33c0: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
33d0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
33e0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
33f0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
3400: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
3410: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
3420: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
3430: 24 73 65 72 76 65 72 4b 65 79 20 32 38 33 32 20 $serverKey 2832
3440: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
3450: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
3460: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
3470: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
3480: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
3490: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
34a0: 66 69 6c 65 5d 22 0a 20 20 20 20 20 20 20 20 20 file]".
34b0: 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 close $file.
34c0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
34d0: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
34e0: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
34f0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
3500: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 er..close $f.
3510: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3520: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3530: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
3540: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
3550: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
3560: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
3570: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
3580: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
3590: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
35a0: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
35b0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
35c0: 32 37 2e 30 2e 30 2e 31 20 32 38 33 32 7d 20 73 27.0.0.1 2832} s
35d0: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
35e0: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
35f0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
3600: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
3610: 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 o..flush $sock.
3620: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
3630: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
3640: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
3650: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3660: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 f. set x.} {r
3670: 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 eady hello}.test
3680: 20 74 6c 73 49 4f 2d 32 2e 36 20 7b 74 63 70 20 tlsIO-2.6 {tcp
3690: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
36a0: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ket} {. set s
36b0: 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 tatus ok. if
36c0: 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 6f {![catch {set so
36d0: 63 6b 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ck [tls::socket
36e0: 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 33 5d 7d 127.0.0.1 2833]}
36f0: 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 ]} {..if {![catc
3700: 68 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d 7d h {gets $sock}]}
3710: 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 {.. set stat
3720: 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c us broken..}..cl
3730: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
3740: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d set status.}
3750: 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ok..test tlsIO-
3760: 32 2e 37 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2.7 {echo server
3770: 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 , one line} {soc
3780: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3790: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
37a0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
37b0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
37c0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
37d0: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
37e0: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
37f0: 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 6f r 2000 "set x do
3800: 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 ne"]. }. p
3810: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
3820: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
3830: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
3840: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
3850: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3860: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
3870: 72 4b 65 79 20 32 38 33 34 20 5c 5d 22 0a 20 20 rKey 2834 \]".
3880: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
3890: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
38a0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 {. f
38b0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
38c0: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
38d0: 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 $s].. fconfig
38e0: 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 ure $s -translat
38f0: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 69 6e ion lf -bufferin
3900: 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d g line. }
3910: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
3920: 7b 0a 09 20 20 20 20 20 73 65 74 20 6c 20 5b 67 {.. set l [g
3930: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
3940: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
3950: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
3960: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
3970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3980: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
3990: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
39a0: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
39b0: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
39d0: 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 $s $l.
39e0: 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 }..}..puts r
39f0: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
3a00: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
3a10: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 er..close $f..pu
3a20: 74 73 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 ts done. }.
3a30: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
3a40: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
3a50: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
3a60: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
3a70: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 r]. gets $f.
3a80: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
3a90: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
3aa0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
3ab0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
3ac0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
3ad0: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 ey 127.0.0.1 283
3ae0: 34 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 4]. fconfigur
3af0: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
3b00: 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f line -translatio
3b10: 6e 20 6c 66 0a 20 20 20 20 70 75 74 73 20 24 73 n lf. puts $s
3b20: 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 "hello abcdefgh
3b30: 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 20 20 20 61 66 ijklmnop". af
3b40: 74 65 72 20 31 30 30 30 0a 20 20 20 20 73 65 74 ter 1000. set
3b50: 20 78 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 x [gets $s].
3b60: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
3b70: 74 20 79 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t y [gets $f].
3b80: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 6c close $f. l
3b90: 69 73 74 20 24 78 20 24 79 0a 7d 20 7b 7b 68 65 ist $x $y.} {{he
3ba0: 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c llo abcdefghijkl
3bb0: 6d 6e 6f 70 7d 20 64 6f 6e 65 7d 0a 0a 74 65 73 mnop} done}..tes
3bc0: 74 20 74 6c 73 49 4f 2d 32 2e 38 20 7b 65 63 68 t tlsIO-2.8 {ech
3bd0: 6f 20 73 65 72 76 65 72 2c 20 6c 6f 6f 70 20 35 o server, loop 5
3be0: 30 20 74 69 6d 65 73 2c 20 73 69 6e 67 6c 65 20 0 times, single
3bf0: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
3c00: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3c10: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
3c20: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
3c30: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
3c40: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 e require tls.
3c50: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
3c60: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
3c70: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
3c80: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
3c90: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
3ca0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
3cb0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 le $serverKey 28
3cc0: 33 35 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 35 \]". puts
3cd0: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
3ce0: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 t {s a p} {.
3cf0: 20 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e fileeven
3d00: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
3d10: 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 ist echo $s].
3d20: 20 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 fconfig
3d30: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
3d40: 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d g line. }
3d50: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
3d60: 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 {.. global i
3d70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 . se
3d80: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t l [gets $s].
3d90: 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b if {[
3da0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 eof $s]} {.
3db0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
3dc0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
3dd0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 close $s.
3de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3df0: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
3e00: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
3e10: 20 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 .. incr
3e20: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
3e30: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
3e40: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
3e50: 0a 09 73 65 74 20 69 20 30 0a 09 70 75 74 73 20 ..set i 0..puts
3e60: 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 72 ready..set timer
3e70: 20 5b 61 66 74 65 72 20 32 30 30 30 30 20 22 73 [after 20000 "s
3e80: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 76 77 61 et x done"]..vwa
3e90: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
3ea0: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
3eb0: 20 24 66 0a 09 70 75 74 73 20 22 64 6f 6e 65 20 $f..puts "done
3ec0: 24 69 22 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $i". }. cl
3ed0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
3ee0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
3ef0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
3f00: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
3f10: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
3f20: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
3f30: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
3f40: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
3f50: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
3f60: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
3f70: 32 37 2e 30 2e 30 2e 31 20 32 38 33 35 5d 0a 20 27.0.0.1 2835].
3f80: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
3f90: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
3fa0: 0a 20 20 20 20 63 61 74 63 68 20 7b 0a 09 66 6f . catch {..fo
3fb0: 72 20 7b 73 65 74 20 78 20 30 7d 20 7b 24 78 20 r {set x 0} {$x
3fc0: 3c 20 35 30 7d 20 7b 69 6e 63 72 20 78 7d 20 7b < 50} {incr x} {
3fd0: 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 22 68 .. puts $s "h
3fe0: 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b ello abcdefghijk
3ff0: 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 67 65 74 73 lmnop".. gets
4000: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
4010: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 61 close $s. ca
4020: 74 63 68 20 7b 73 65 74 20 78 20 5b 67 65 74 73 tch {set x [gets
4030: 20 24 66 5d 7d 0a 20 20 20 20 63 6c 6f 73 65 20 $f]}. close
4040: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
4050: 64 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 74 20 74 done 50}..test t
4060: 6c 73 49 4f 2d 32 2e 39 20 7b 73 6f 63 6b 65 74 lsIO-2.9 {socket
4070: 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b conflict} {sock
4080: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
4090: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
40a0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
40b0: 74 20 32 38 32 38 5d 0a 20 20 20 20 72 65 6d 6f t 2828]. remo
40c0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
40d0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
40e0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
40f0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 7b -nonewline $f {
4100: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
4110: 74 6c 73 3b 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 tls; tls::socket
4120: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4130: 32 38 32 38 7d 0a 20 20 20 20 63 6c 6f 73 65 20 2828}. close
4140: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
4150: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
4160: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
4170: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
4180: 65 74 73 20 24 66 0a 20 20 20 20 61 66 74 65 72 ets $f. after
4190: 20 31 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 100. set x [
41a0: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 63 6c 6f list [catch {clo
41b0: 73 65 20 24 66 7d 20 6d 73 67 5d 20 24 6d 73 67 se $f} msg] $msg
41c0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
41d0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 set x.} {1 {c
41e0: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
41f0: 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 ket: address alr
4200: 65 61 64 79 20 69 6e 20 75 73 65 0a 20 20 20 20 eady in use.
4210: 77 68 69 6c 65 20 65 78 65 63 75 74 69 6e 67 0a while executing.
4220: 22 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 "::socket -serve
4230: 72 20 7b 74 6c 73 3a 3a 5f 61 63 63 65 70 74 20 r {tls::_accept
4240: 7b 2d 73 65 72 76 65 72 20 31 7d 20 61 63 63 65 {-server 1} acce
4250: 70 74 7d 20 32 38 32 38 22 0a 20 20 20 20 28 22 pt} 2828". ("
4260: 65 76 61 6c 22 20 62 6f 64 79 20 6c 69 6e 65 20 eval" body line
4270: 31 29 0a 20 20 20 20 69 6e 76 6f 6b 65 64 20 66 1). invoked f
4280: 72 6f 6d 20 77 69 74 68 69 6e 0a 22 65 76 61 6c rom within."eval
4290: 20 3a 3a 73 6f 63 6b 65 74 20 24 73 6f 70 74 73 ::socket $sopts
42a0: 22 0a 20 20 20 20 28 70 72 6f 63 65 64 75 72 65 ". (procedure
42b0: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 22 20 6c "tls::socket" l
42c0: 69 6e 65 20 36 32 29 0a 20 20 20 20 69 6e 76 6f ine 62). invo
42d0: 6b 65 64 20 66 72 6f 6d 20 77 69 74 68 69 6e 0a ked from within.
42e0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
42f0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 rver accept 2828
4300: 22 0a 20 20 20 20 28 66 69 6c 65 20 22 73 63 72 ". (file "scr
4310: 69 70 74 22 20 6c 69 6e 65 20 31 29 7d 7d 0a 0a ipt" line 1)}}..
4320: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 30 20 test tlsIO-2.10
4330: 7b 63 6c 6f 73 65 20 6f 6e 20 61 63 63 65 70 74 {close on accept
4340: 2c 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 , accepted socke
4350: 74 20 6c 69 76 65 73 7d 20 7b 73 6f 63 6b 65 74 t lives} {socket
4360: 20 6b 6e 6f 77 6e 42 75 67 7d 20 7b 0a 20 20 20 knownBug} {.
4370: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
4380: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
4390: 20 32 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20000 "set done
43a0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
43b0: 20 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 6f set ss [tls::so
43c0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
43d0: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
43e0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
43f0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
4400: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
4410: 20 32 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 2830]. proc
4420: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
4430: 0a 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 6c 6f ..global ss..clo
4440: 73 65 20 24 73 73 0a 09 66 69 6c 65 65 76 65 6e se $ss..fileeven
4450: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
4460: 65 61 64 69 74 20 24 73 22 0a 09 66 63 6f 6e 66 eadit $s"..fconf
4470: 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 20 igure $s -trans
4480: 6c 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f lf. }. pro
4490: 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 c readit {s} {..
44a0: 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 65 74 global done..get
44b0: 73 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 0a 09 s $s..close $s..
44c0: 73 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 20 7d set done 1. }
44d0: 0a 20 20 20 20 73 65 74 20 63 73 20 5b 74 6c 73 . set cs [tls
44e0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
44f0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
4500: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4510: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
4520: 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f 73 74 ntKey [info host
4530: 6e 61 6d 65 5d 20 32 38 33 30 5d 0a 20 20 20 20 name] 2830].
4540: 63 6c 6f 73 65 20 24 63 73 0a 0a 20 20 20 20 76 close $cs.. v
4550: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 wait done. af
4560: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
4570: 72 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d r. set done.}
4580: 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 1..test tlsIO-2
4590: 2e 31 31 20 7b 64 65 74 65 63 74 69 6e 67 20 6e .11 {detecting n
45a0: 65 77 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 74 ew data} {socket
45b0: 20 6b 6e 6f 77 6e 42 75 67 7d 20 7b 0a 20 20 20 knownBug} {.
45c0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
45d0: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 a p} {..global s
45e0: 6f 63 6b 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 ock..set sock $s
45f0: 0a 09 73 65 74 20 66 20 5b 6f 70 65 6e 20 61 77 ..set f [open aw
4600: 62 2e 6c 6f 67 20 77 5d 0a 09 70 75 74 73 20 24 b.log w]..puts $
4610: 66 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 f [catch {tls::h
4620: 61 6e 64 73 68 61 6b 65 20 24 73 6f 63 6b 7d 20 andshake $sock}
4630: 65 72 72 5d 0a 09 70 75 74 73 20 24 66 20 22 65 err]..puts $f "e
4640: 72 72 3a 20 24 65 72 72 22 0a 09 70 75 74 73 20 rr: $err"..puts
4650: 24 66 20 22 5b 74 6c 73 3a 3a 73 74 61 74 75 73 $f "[tls::status
4660: 20 24 73 6f 63 6b 5d 22 0a 09 63 6c 6f 73 65 20 $sock]"..close
4670: 24 73 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 $s. }.. se
4680: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
4690: 20 2d 72 65 71 75 69 72 65 20 30 20 2d 72 65 71 -require 0 -req
46a0: 75 65 73 74 20 30 20 2d 73 65 72 76 65 72 20 61 uest 0 -server a
46b0: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
46c0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
46d0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
46e0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
46f0: 65 79 20 32 34 30 30 5d 0a 20 20 20 20 73 65 74 ey 2400]. set
4700: 20 73 6f 63 6b 20 22 22 0a 20 20 20 20 73 65 74 sock "". set
4710: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
4720: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4730: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4740: 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 caCert \..-keyfi
4750: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 le $clientKey 12
4760: 37 2e 30 2e 30 2e 31 20 32 34 30 30 5d 0a 20 20 7.0.0.1 2400].
4770: 20 20 76 77 61 69 74 20 73 6f 63 6b 0a 20 20 20 vwait sock.
4780: 20 70 75 74 73 20 24 73 32 20 6f 6e 65 0a 20 20 puts $s2 one.
4790: 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 flush $s2.
47a0: 61 66 74 65 72 20 35 30 30 0a 20 20 20 20 66 63 after 500. fc
47b0: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
47c0: 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 73 blocking 0. s
47d0: 65 74 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 et result [gets
47e0: 24 73 6f 63 6b 5d 0a 20 20 20 20 6c 61 70 70 65 $sock]. lappe
47f0: 6e 64 20 72 65 73 75 6c 74 20 5b 67 65 74 73 20 nd result [gets
4800: 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 $sock]. fconf
4810: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
4820: 63 6b 69 6e 67 20 31 0a 20 20 20 20 70 75 74 73 cking 1. puts
4830: 20 24 73 32 20 74 77 6f 0a 20 20 20 20 66 6c 75 $s2 two. flu
4840: 73 68 20 24 73 32 0a 20 20 20 20 66 63 6f 6e 66 sh $s2. fconf
4850: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
4860: 63 6b 69 6e 67 20 30 0a 20 20 20 20 6c 61 70 70 cking 0. lapp
4870: 65 6e 64 20 72 65 73 75 6c 74 20 5b 67 65 74 73 end result [gets
4880: 20 24 73 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e $sock]. fcon
4890: 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c figure $sock -bl
48a0: 6f 63 6b 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f ocking 1. clo
48b0: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
48c0: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
48d0: 6f 63 6b 0a 20 20 20 20 73 65 74 20 72 65 73 75 ock. set resu
48e0: 6c 74 0a 7d 20 7b 6f 6e 65 20 7b 7d 20 74 77 6f lt.} {one {} two
48f0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
4900: 31 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 12 {tcp connecti
4910: 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 66 69 63 61 on; no certifica
4920: 74 65 73 20 73 70 65 63 69 66 69 65 64 7d 20 7b tes specified} {
4930: 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 socket stdio pcC
4940: 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rash} {. remo
4950: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
4960: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
4970: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
4980: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
4990: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
49a0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
49b0: 20 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 2000 "set x tim
49c0: 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 ed_out"]..set f
49d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
49e0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 38 rver accept 2828
49f0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
4a00: 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d 20 file addr port}
4a10: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a {.. global x.
4a20: 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a . set x done.
4a30: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
4a40: 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 e $file..}..puts
4a50: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
4a60: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
4a70: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 imer..close $f..
4a80: 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 puts $x. }.
4a90: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
4aa0: 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 et f [open "|[li
4ab0: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
4ac0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
4ad0: 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 r]. gets $f x
4ae0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
4af0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 {tls::socket 127
4b00: 2e 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 .0.0.1 2828} msg
4b10: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
4b20: 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c x $msg. } el
4b30: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 se {. lap
4b40: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
4b50: 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 . close $
4b60: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 msg. }. la
4b70: 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 ppend x [gets $f
4b80: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 ]. close $f.
4b90: 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 set x.} {read
4ba0: 79 20 64 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 y done {}}..test
4bb0: 20 74 6c 73 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b tlsIO-3.1 {sock
4bc0: 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f et conflict} {so
4bd0: 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 cket stdio} {.
4be0: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
4bf0: 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ipt. set f [o
4c00: 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 pen script w].
4c10: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
4c20: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
4c30: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
4c40: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
4c50: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
4c60: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
4c70: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
4c80: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4c90: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
4ca0: 72 4b 65 79 20 32 38 32 38 20 5c 5d 22 0a 20 20 rKey 2828 \]".
4cb0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 75 74 puts $f {..put
4cc0: 73 20 72 65 61 64 79 0a 09 67 65 74 73 20 73 74 s ready..gets st
4cd0: 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 din..close $f.
4ce0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
4cf0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4d00: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
4d10: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
4d20: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 67 65 ipt]" r+]. ge
4d30: 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 78 20 ts $f. set x
4d40: 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c [list [catch {tl
4d50: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
4d60: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
4d70: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
4d80: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
4d90: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
4da0: 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 .-server accept
4db0: 20 32 38 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 09 2828} msg] \...
4dc0: 24 6d 73 67 5d 0a 20 20 20 20 70 75 74 73 20 24 $msg]. puts $
4dd0: 66 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 f bye. close
4de0: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
4df0: 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 1 {couldn't open
4e00: 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 73 socket: address
4e10: 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 7d already in use}
4e20: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e }..test tlsIO-3.
4e30: 32 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 2 {server with s
4e40: 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 everal clients}
4e50: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
4e60: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
4e70: 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 script. set f
4e80: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d [open script w]
4e90: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 . puts $f {.
4ea0: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
4eb0: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 31 20 ire tls..set t1
4ec0: 5b 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 [after 30000 "se
4ed0: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
4ee0: 09 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 .set t2 [after 3
4ef0: 31 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 1000 "set x time
4f00: 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 33 20 d_out"]..set t3
4f10: 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 73 65 [after 32000 "se
4f20: 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a t x timed_out"].
4f30: 09 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 .set counter 0.
4f40: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
4f50: 20 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 "set s \[tls::s
4f60: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4f70: 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cept -certfile $
4f80: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
4f90: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
4fa0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 ile $serverKey 2
4fb0: 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 828 \]". puts
4fc0: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
4fd0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
4fe0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
4ff0: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
5000: 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e ho $s].. fcon
5010: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
5020: 72 69 6e 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 ring line..}..pr
5030: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
5040: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
5050: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 set l
5060: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
5070: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
5080: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
5090: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
50a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
50b0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
50c0: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
50d0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
50e0: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
50f0: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
5100: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
5110: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
5120: 63 65 6c 20 24 74 31 0a 09 76 77 61 69 74 20 78 cel $t1..vwait x
5130: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
5140: 74 32 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 t2..vwait x..aft
5150: 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 er cancel $t3..c
5160: 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 24 78 lose $s..puts $x
5170: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
5180: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
5190: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
51a0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
51b0: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
51c0: 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 66 5d set x [gets $f]
51d0: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
51e0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
51f0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
5200: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
5210: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5220: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
5230: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 5d 127.0.0.1 2828]
5240: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5250: 24 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s1 -buffering l
5260: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 5b ine. set s2 [
5270: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
5280: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
5290: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
52a0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
52b0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
52c0: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 127.0.0.1 28
52d0: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
52e0: 72 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e re $s2 -bufferin
52f0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 g line. set s
5300: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 3 [tls::socket \
5310: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
5320: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
5330: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
5340: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
5350: 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 \.. 127.0.0.1
5360: 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 2828]. fconf
5370: 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 igure $s3 -buffe
5380: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f ring line. fo
5390: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
53a0: 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 < 100} {incr i}
53b0: 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c {..puts $s1 hell
53c0: 6f 2c 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 o,s1..gets $s1..
53d0: 70 75 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 73 puts $s2 hello,s
53e0: 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 74 2..gets $s2..put
53f0: 73 20 24 73 33 20 68 65 6c 6c 6f 2c 73 33 0a 09 s $s3 hello,s3..
5400: 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a 20 gets $s3. }.
5410: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
5420: 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 close $s2. c
5430: 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 6c 61 70 lose $s3. lap
5440: 70 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d pend x [gets $f]
5450: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
5460: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
5470: 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 done}..test tls
5480: 49 4f 2d 34 2e 31 20 7b 73 65 72 76 65 72 20 77 IO-4.1 {server w
5490: 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 ith several clie
54a0: 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 nts} {socket std
54b0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
54c0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
54d0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
54e0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
54f0: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
5500: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 require tls..ge
5510: 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 ts stdin. }.
5520: 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 puts $f "set
5530: 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s \[tls::socket
5540: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
5550: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
5560: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5570: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
5580: 30 2e 31 20 32 38 32 38 20 5c 5d 22 0a 20 20 20 0.1 2828 \]".
5590: 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e puts $f {..fcon
55a0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
55b0: 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 7b ring line..for {
55c0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
55d0: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
55e0: 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c 6c puts $s hell
55f0: 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a 09 o.. gets $s..
5600: 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 }..close $s..put
5610: 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 69 s bye..gets stdi
5620: 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 n. }. clos
5630: 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 20 e $f. set p1
5640: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
5650: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
5660: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
5670: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 fconfigure $p
5680: 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 1 -buffering lin
5690: 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f 70 e. set p2 [op
56a0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
56b0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
56c0: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
56d0: 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 20 2d fconfigure $p2 -
56e0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
56f0: 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 6e 20 set p3 [open
5700: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
5710: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
5720: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f pt]" r+]. fco
5730: 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 75 66 nfigure $p3 -buf
5740: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5750: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
5760: 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 p} {..fconfigur
5770: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
5780: 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 line..fileevent
5790: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
57a0: 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 7d t echo $s]. }
57b0: 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f 20 7b . proc echo {
57c0: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 20 s} {..global x.
57d0: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
57e0: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 69 ts $s]. i
57f0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
5800: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
5810: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
5820: 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 set x done.
5830: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
5840: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
5850: 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 $l. }.
5860: 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 5b 61 }. set t1 [a
5870: 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74 20 fter 30000 "set
5880: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
5890: 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 72 20 set t2 [after
58a0: 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 31000 "set x tim
58b0: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 ed_out"]. set
58c0: 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 30 30 t3 [after 32000
58d0: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
58e0: 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 t"]. set s [t
58f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
5900: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
5910: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
5920: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5930: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 $serverKey \.
5940: 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 .-server accep
5950: 74 20 32 38 32 38 5d 0a 20 20 20 20 70 75 74 73 t 2828]. puts
5960: 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 $p1 open. pu
5970: 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 ts $p2 open.
5980: 70 75 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 puts $p3 open.
5990: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 77 vwait x. vw
59a0: 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 20 ait x. vwait
59b0: 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 x. after canc
59c0: 65 6c 20 24 74 31 0a 20 20 20 20 61 66 74 65 72 el $t1. after
59d0: 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 cancel $t2.
59e0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 33 after cancel $t3
59f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
5a00: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
5a10: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 append l [list p
5a20: 31 20 5b 67 65 74 73 20 24 70 31 5d 20 24 78 5d 1 [gets $p1] $x]
5a30: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
5a40: 6c 69 73 74 20 70 32 20 5b 67 65 74 73 20 24 70 list p2 [gets $p
5a50: 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 2] $x]. lappe
5a60: 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 nd l [list p3 [g
5a70: 65 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 ets $p3] $x].
5a80: 20 70 75 74 73 20 24 70 31 20 62 79 65 0a 20 20 puts $p1 bye.
5a90: 20 20 70 75 74 73 20 24 70 32 20 62 79 65 0a 20 puts $p2 bye.
5aa0: 20 20 20 70 75 74 73 20 24 70 33 20 62 79 65 0a puts $p3 bye.
5ab0: 20 20 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 close $p1.
5ac0: 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 close $p2.
5ad0: 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 73 65 close $p3. se
5ae0: 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 t l.} {{p1 bye d
5af0: 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e one} {p2 bye don
5b00: 65 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d e} {p3 bye done}
5b10: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e }..test tlsIO-4.
5b20: 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 2 {byte order pr
5b30: 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e oblems, socket n
5b40: 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b umbers, htons} {
5b50: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
5b60: 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b t x ok. if {[
5b70: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
5b80: 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 et -server dodo
5b90: 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 0x3000} msg]} {.
5ba0: 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 20 .set x $msg.
5bb0: 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 } else {..close
5bc0: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
5bd0: 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 et x.} ok..test
5be0: 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 74 65 20 tlsIO-5.1 {byte
5bf0: 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 order problems,
5c00: 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 socket numbers,
5c10: 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 htons} \..{socke
5c20: 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f t unixOnly notRo
5c30: 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 20 ot} {. set x
5c40: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
5c50: 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 ocket: not owner
5c60: 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 }. if {![catc
5c70: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
5c80: 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 7d server dodo 0x1}
5c90: 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 msg]} {.
5ca0: 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 set x {htons pr
5cb0: 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 oblem, should be
5cc0: 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 disallowed, are
5cd0: 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 you running as
5ce0: 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 SU?}..close $msg
5cf0: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
5d00: 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 .} {couldn't ope
5d10: 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 n socket: not ow
5d20: 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d ner}.test tlsIO-
5d30: 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.2 {byte order
5d40: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
5d50: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
5d60: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
5d70: 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 set x {couldn't
5d80: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 open socket: por
5d90: 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 t number too hig
5da0: 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 h}. if {![cat
5db0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
5dc0: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 -server dodo 0x1
5dd0: 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 0000} msg]} {..s
5de0: 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c et x {port resol
5df0: 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 ution problem, s
5e00: 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f hould be disallo
5e10: 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 wed}..close $msg
5e20: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 . }. set x
5e30: 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 .} {couldn't ope
5e40: 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e n socket: port n
5e50: 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a umber too high}.
5e60: 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 33 20 7b test tlsIO-5.3 {
5e70: 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c byte order probl
5e80: 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 ems, socket numb
5e90: 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b ers, htons} \..{
5ea0: 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 socket unixOnly
5eb0: 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 notRoot} {. s
5ec0: 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f et x {couldn't o
5ed0: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
5ee0: 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 owner}. if {!
5ef0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
5f00: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
5f10: 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 21} msg]} {..se
5f20: 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c t x {htons probl
5f30: 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 em, should be di
5f40: 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f sallowed, are yo
5f50: 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f u running as SU?
5f60: 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 }..close $msg.
5f70: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
5f80: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
5f90: 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 ocket: not owner
5fa0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 36 2e }..test tlsIO-6.
5fb0: 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 1 {accept callba
5fc0: 63 6b 20 65 72 72 6f 72 7d 20 7b 75 6e 65 78 70 ck error} {unexp
5fd0: 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 6f lainedFailure so
5fe0: 63 6b 65 74 20 73 74 64 69 6f 20 70 63 43 72 61 cket stdio pcCra
5ff0: 73 68 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 sh} {. remove
6000: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
6010: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
6020: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
6030: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
6040: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 require tls..ge
6050: 74 73 20 73 74 64 69 6e 0a 09 74 6c 73 3a 3a 73 ts stdin..tls::s
6060: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
6070: 32 38 34 38 0a 20 20 20 20 7d 0a 20 20 20 20 63 2848. }. c
6080: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
6090: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
60a0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
60b0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
60c0: 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f . proc bgerro
60d0: 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c r args {..global
60e0: 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a x..set x $args.
60f0: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 }. proc a
6100: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 ccept {s a p} {e
6110: 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 xpr 10 / 0}.
6120: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
6130: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
6140: 74 20 32 38 34 38 5d 0a 20 20 20 20 70 75 74 73 t 2848]. puts
6150: 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 6c $f hello. cl
6160: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 74 ose $f. set t
6170: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
6180: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
6190: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 ut"]. vwait x
61a0: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
61b0: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f l $timer. clo
61c0: 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d 65 se $s. rename
61d0: 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 20 bgerror {}.
61e0: 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 65 set x.} {{divide
61f0: 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 23 20 62 75 by zero}}..# bu
6200: 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 g report #5812 f
6210: 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 configure doesn'
6220: 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 t return value f
6230: 6f 72 20 27 2d 70 65 65 72 6e 61 6d 65 27 0a 0a or '-peername'..
6240: 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 31 20 7b test tlsIO-7.1 {
6250: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
6260: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
6270: 20 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 {knownBug socke
6280: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
6290: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
62a0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
62b0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
62c0: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
62d0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 e require tls.
62e0: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
62f0: 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 "tls::socket -se
6300: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
6310: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
6320: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6330: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
6340: 65 72 4b 65 79 20 32 38 32 30 22 0a 20 20 20 20 erKey 2820".
6350: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
6360: 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 accept args {..
6370: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
6380: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
6390: 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 puts ready..set
63a0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
63b0: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
63c0: 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 out"]..vwait x..
63d0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
63e0: 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c mer. }. cl
63f0: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
6400: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
6410: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
6420: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
6430: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
6440: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
6450: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
6460: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
6470: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
6480: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
6490: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
64a0: 30 2e 31 20 32 38 32 30 5d 0a 20 20 20 20 73 65 0.1 2820]. se
64b0: 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t p [fconfigure
64c0: 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 $s -peername].
64d0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
64e0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
64f0: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
6500: 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 l [string compa
6510: 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d re [lindex $p 0]
6520: 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 127.0.0.1].
6530: 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e lappend l [strin
6540: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
6550: 78 20 24 70 20 32 5d 20 32 38 32 30 5d 0a 20 20 x $p 2] 2820].
6560: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 lappend l [lle
6570: 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20 ngth $p].} {0 0
6580: 33 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 3}..# bug report
6590: 20 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 #5812 fconfigur
65a0: 65 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e e doesn't return
65b0: 20 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 value for '-soc
65c0: 6b 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 kname'..test tls
65d0: 49 4f 2d 37 2e 32 20 7b 74 65 73 74 69 6e 67 20 IO-7.2 {testing
65e0: 73 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 socket specific
65f0: 6f 70 74 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 6e 42 options} {knownB
6600: 75 67 20 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d ug socket stdio}
6610: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
6620: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
6630: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
6640: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
6650: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
6660: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
6670: 70 75 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f puts $f "tls::so
6680: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
6690: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
66a0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
66b0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
66c0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 le $serverKey 28
66d0: 32 31 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 21". puts $f
66e0: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 {..proc accept a
66f0: 72 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 rgs {.. globa
6700: 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 l x.. set x d
6710: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
6720: 64 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 dy..set timer [a
6730: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
6740: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 x timed_out"]..v
6750: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
6760: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
6770: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 }. close $f.
6780: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 set f [open "
6790: 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 |[list $::tcltes
67a0: 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 t::tcltest scrip
67b0: 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 t]" r]. gets
67c0: 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c $f. set s [tl
67d0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
67e0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
67f0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
6800: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6810: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
6820: 20 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 31 127.0.0.1 2821
6830: 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f ]. set p [fco
6840: 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b nfigure $s -sock
6850: 6e 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 name]. close
6860: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a $s. close $f.
6870: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
6880: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e lappend l [llen
6890: 67 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 gth $p]. lapp
68a0: 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 end l [lindex $p
68b0: 20 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 0]. lappend
68c0: 6c 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20 l [string equal
68d0: 5b 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 32 38 [lindex $p 2] 28
68e0: 32 31 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 21].} {3 127.0.0
68f0: 2e 31 20 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 .1 0}..test tlsI
6900: 4f 2d 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 O-7.3 {testing s
6910: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
6920: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d ptions} {socket}
6930: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
6940: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
6950: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
6960: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6970: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
6980: 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 verKey \. .-s
6990: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
69a0: 32 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 66 63 2]. set l [fc
69b0: 6f 6e 66 69 67 75 72 65 20 24 73 5d 0a 20 20 20 onfigure $s].
69c0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 close $s. up
69d0: 64 61 74 65 0a 20 20 20 20 6c 6c 65 6e 67 74 68 date. llength
69e0: 20 24 6c 0a 7d 20 31 32 0a 0a 23 20 62 75 67 20 $l.} 12..# bug
69f0: 72 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f report #5812 fco
6a00: 6e 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 nfigure doesn't
6a10: 72 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 return value for
6a20: 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 '-sockname'..te
6a30: 73 74 20 74 6c 73 49 4f 2d 37 2e 34 20 7b 74 65 st tlsIO-7.4 {te
6a40: 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 sting socket spe
6a50: 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b cific options} {
6a60: 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 7d knownBug socket}
6a70: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
6a80: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
6a90: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
6aa0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6ab0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
6ac0: 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 verKey \. .-s
6ad0: 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 32 erver accept 282
6ae0: 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 3]. proc acce
6af0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
6b00: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
6b10: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
6b20: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
6b30: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
6b40: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
6b50: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
6b60: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
6b70: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6b80: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
6b90: 20 20 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 .[info hostna
6ba0: 6d 65 5d 20 32 38 32 33 5d 0a 20 20 20 20 73 65 me] 2823]. se
6bb0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
6bc0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
6bd0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
6be0: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
6bf0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
6c00: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
6c10: 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 6c se $s1. set l
6c20: 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 "". lappend
6c30: 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 l [lindex $x 2]
6c40: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
6c50: 32 38 32 33 20 33 7d 0a 0a 23 20 62 75 67 20 72 2823 3}..# bug r
6c60: 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e eport #5812 fcon
6c70: 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 figure doesn't r
6c80: 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 eturn value for
6c90: 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 '-sockname'..tes
6ca0: 74 20 74 6c 73 49 4f 2d 37 2e 35 20 7b 74 65 73 t tlsIO-7.5 {tes
6cb0: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
6cc0: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b ific options} {k
6cd0: 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 20 75 nownBug socket u
6ce0: 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 20 20 73 nixOrPc} {. s
6cf0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
6d00: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
6d10: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
6d20: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6d30: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
6d40: 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 63 . .-server ac
6d50: 63 65 70 74 20 32 38 32 39 5d 0a 20 20 20 20 70 cept 2829]. p
6d60: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
6d70: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 p} {..global x..
6d80: 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 set x [fconfigur
6d90: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
6da0: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
6db0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
6dc0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
6dd0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
6de0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
6df0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
6e00: 74 4b 65 79 20 5c 0a 20 20 20 20 09 31 32 37 2e tKey \. .127.
6e10: 30 2e 30 2e 31 20 32 38 32 39 5d 0a 20 20 20 20 0.0.1 2829].
6e20: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6e30: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6e40: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6e50: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6e60: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6e70: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
6e80: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 73 65 74 lose $s1. set
6e90: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
6ea0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 78 20 30 d l [lindex $x 0
6eb0: 5d 20 5b 6c 69 6e 64 65 78 20 24 78 20 32 5d 20 ] [lindex $x 2]
6ec0: 5b 6c 6c 65 6e 67 74 68 20 24 78 5d 0a 7d 20 7b [llength $x].} {
6ed0: 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 20 33 127.0.0.1 2829 3
6ee0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 38 2e }..test tlsIO-8.
6ef0: 31 20 7b 74 65 73 74 69 6e 67 20 2d 61 73 79 6e 1 {testing -asyn
6f00: 63 20 66 6c 61 67 20 6f 6e 20 73 6f 63 6b 65 74 c flag on socket
6f10: 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 s} {unexplainedH
6f20: 61 6e 67 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 ang socket} {.
6f30: 20 20 23 20 74 65 73 74 20 73 65 65 6d 73 20 74 # test seems t
6f40: 6f 20 68 61 6e 67 20 2d 2d 20 61 77 62 20 36 2f o hang -- awb 6/
6f50: 32 2f 32 30 30 30 0a 20 20 20 20 23 20 4e 4f 54 2/2000. # NOT
6f60: 45 3a 20 54 68 69 73 20 74 65 73 74 20 6d 61 79 E: This test may
6f70: 20 66 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f fail on some So
6f80: 6c 61 72 69 73 20 32 2e 34 20 73 79 73 74 65 6d laris 2.4 system
6f90: 73 2e 20 49 66 20 69 74 20 64 6f 65 73 2c 0a 20 s. If it does,.
6fa0: 20 20 20 23 20 63 68 65 63 6b 20 74 68 61 74 20 # check that
6fb0: 79 6f 75 20 68 61 76 65 20 74 68 65 73 65 20 70 you have these p
6fc0: 61 74 63 68 65 73 20 69 6e 73 74 61 6c 6c 65 64 atches installed
6fd0: 20 28 75 73 69 6e 67 20 73 68 6f 77 72 65 76 20 (using showrev
6fe0: 2d 70 29 3a 0a 20 20 20 20 23 0a 20 20 20 20 23 -p):. #. #
6ff0: 20 31 30 31 39 30 37 2d 30 35 2c 20 31 30 31 39 101907-05, 1019
7000: 32 35 2d 30 32 2c 20 31 30 31 39 34 35 2d 31 34 25-02, 101945-14
7010: 2c 20 31 30 31 39 35 39 2d 30 33 2c 20 31 30 31 , 101959-03, 101
7020: 39 36 39 2d 30 35 2c 20 31 30 31 39 37 33 2d 30 969-05, 101973-0
7030: 33 2c 0a 20 20 20 20 23 20 31 30 31 39 37 37 2d 3,. # 101977-
7040: 30 33 2c 20 31 30 31 39 38 31 2d 30 32 2c 20 31 03, 101981-02, 1
7050: 30 31 39 38 35 2d 30 31 2c 20 31 30 32 30 30 31 01985-01, 102001
7060: 2d 30 33 2c 20 31 30 32 30 30 33 2d 30 31 2c 20 -03, 102003-01,
7070: 31 30 32 30 30 37 2d 30 31 2c 0a 20 20 20 20 23 102007-01,. #
7080: 20 31 30 32 30 31 31 2d 30 32 2c 20 31 30 32 30 102011-02, 1020
7090: 32 34 2d 30 31 2c 20 31 30 32 30 33 39 2d 30 31 24-01, 102039-01
70a0: 2c 20 31 30 32 30 34 34 2d 30 31 2c 20 31 30 32 , 102044-01, 102
70b0: 30 34 38 2d 30 31 2c 20 31 30 32 30 36 32 2d 30 048-01, 102062-0
70c0: 33 2c 0a 20 20 20 20 23 20 31 30 32 30 36 36 2d 3,. # 102066-
70d0: 30 34 2c 20 31 30 32 30 37 30 2d 30 31 2c 20 31 04, 102070-01, 1
70e0: 30 32 31 30 35 2d 30 31 2c 20 31 30 32 31 35 33 02105-01, 102153
70f0: 2d 30 33 2c 20 31 30 32 32 31 36 2d 30 31 2c 20 -03, 102216-01,
7100: 31 30 32 32 33 32 2d 30 31 2c 0a 20 20 20 20 23 102232-01,. #
7110: 20 31 30 31 38 37 38 2d 30 33 2c 20 31 30 31 38 101878-03, 1018
7120: 37 39 2d 30 31 2c 20 31 30 31 38 38 30 2d 30 33 79-01, 101880-03
7130: 2c 20 31 30 31 39 33 33 2d 30 31 2c 20 31 30 31 , 101933-01, 101
7140: 39 35 30 2d 30 31 2c 20 31 30 32 30 33 30 2d 30 950-01, 102030-0
7150: 31 2c 0a 20 20 20 20 23 20 31 30 32 30 35 37 2d 1,. # 102057-
7160: 30 38 2c 20 31 30 32 31 34 30 2d 30 31 2c 20 31 08, 102140-01, 1
7170: 30 31 39 32 30 2d 30 32 2c 20 31 30 31 39 32 31 01920-02, 101921
7180: 2d 30 39 2c 20 31 30 31 39 32 32 2d 30 37 2c 20 -09, 101922-07,
7190: 31 30 31 39 32 33 2d 30 33 0a 20 20 20 20 23 0a 101923-03. #.
71a0: 20 20 20 20 23 20 49 66 20 61 66 74 65 72 20 69 # If after i
71b0: 6e 73 74 61 6c 6c 69 6e 67 20 74 68 65 73 65 20 nstalling these
71c0: 70 61 74 63 68 65 73 20 79 6f 75 20 61 72 65 20 patches you are
71d0: 73 74 69 6c 6c 20 65 78 70 65 72 69 65 6e 63 69 still experienci
71e0: 6e 67 20 61 0a 20 20 20 20 23 20 70 72 6f 62 6c ng a. # probl
71f0: 65 6d 2c 20 70 6c 65 61 73 65 20 65 6d 61 69 6c em, please email
7200: 20 6a 79 6c 40 65 6e 67 2e 73 75 6e 2e 63 6f 6d jyl@eng.sun.com
7210: 2e 20 57 65 20 68 61 76 65 20 6e 6f 74 20 6f 62 . We have not ob
7220: 73 65 72 76 65 64 20 74 68 69 73 0a 20 20 20 20 served this.
7230: 23 20 66 61 69 6c 75 72 65 20 6f 6e 20 53 6f 6c # failure on Sol
7240: 61 72 69 73 20 32 2e 35 2c 20 73 6f 20 61 6e 6f aris 2.5, so ano
7250: 74 68 65 72 20 6f 70 74 69 6f 6e 20 28 69 6e 73 ther option (ins
7260: 74 65 61 64 20 6f 66 20 69 6e 73 74 61 6c 6c 69 tead of installi
7270: 6e 67 0a 20 20 20 20 23 20 74 68 65 73 65 20 70 ng. # these p
7280: 61 74 63 68 65 73 29 20 69 73 20 74 6f 20 75 70 atches) is to up
7290: 67 72 61 64 65 20 74 6f 20 53 6f 6c 61 72 69 73 grade to Solaris
72a0: 20 32 2e 35 2e 0a 20 20 20 20 73 65 74 20 73 20 2.5.. set s
72b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
72c0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
72d0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
72e0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
72f0: 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 serverKey \.
7300: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
7310: 32 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 61 2830]. proc a
7320: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
7330: 09 67 6c 6f 62 61 6c 20 78 0a 09 70 75 74 73 20 .global x..puts
7340: 24 73 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 $s bye..close $s
7350: 0a 09 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 ..set x done.
7360: 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 }. set s1 [t
7370: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
7380: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
7390: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
73a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
73b0: 69 65 6e 74 4b 65 79 20 5c 0a 09 2d 61 73 79 6e ientKey \..-asyn
73c0: 63 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 c [info hostname
73d0: 5d 20 32 38 33 30 5d 0a 20 20 20 20 76 77 61 69 ] 2830]. vwai
73e0: 74 20 78 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 t x. set z [g
73f0: 65 74 73 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f ets $s1]. clo
7400: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
7410: 24 73 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 $s1. set z.}
7420: 62 79 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d bye..test tlsIO-
7430: 39 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 9.1 {testing spu
7440: 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 75 rious events} {u
7450: 6e 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 nexplainedHang s
7460: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 6c ocket} {. # l
7470: 6f 63 6b 73 20 75 70 20 0a 20 20 20 20 73 65 74 ocks up . set
7480: 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 len 0. set s
7490: 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 purious 0. se
74a0: 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f t done 0. pro
74b0: 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d c readlittle {s}
74c0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 {..global spuri
74d0: 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 ous done len..se
74e0: 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a t l [read $s 1].
74f0: 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e .if {[string len
7500: 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a gth $l] == 0} {.
7510: 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 . if {![eof $
7520: 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 s]} {...incr spu
7530: 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 rious.. } els
7540: 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 e {...close $s..
7550: 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 .set done 1..
7560: 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 }..} else {..
7570: 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 incr len [stri
7580: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d ng length $l]..}
7590: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
75a0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
75b0: 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 ..fconfigure $s
75c0: 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 20 -buffering none
75d0: 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 66 -blocking off..f
75e0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
75f0: 61 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c able [list readl
7600: 69 74 74 6c 65 20 24 73 5d 0a 20 20 20 20 7d 0a ittle $s]. }.
7610: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
7620: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
7630: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
7640: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
7650: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
7660: 4b 65 79 20 5c 0a 20 20 20 09 2d 73 65 72 76 65 Key \. .-serve
7670: 72 20 61 63 63 65 70 74 20 32 38 33 31 5d 0a 20 r accept 2831].
7680: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
7690: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
76a0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
76b0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
76c0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
76d0: 65 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 ey \. .[info
76e0: 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 5d 0a hostname] 2831].
76f0: 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c puts -nonewl
7700: 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 38 ine $c 012345678
7710: 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 34 9012345678901234
7720: 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 30 5678901234567890
7730: 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 6c 123456789. cl
7740: 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 74 ose $c. set t
7750: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
7760: 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 0 "set done time
7770: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
7780: 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 t done. after
7790: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
77a0: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
77b0: 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 list $spurious $
77c0: 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 len.} {0 50}..te
77d0: 73 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 st tlsIO-9.2 {te
77e0: 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 sting async writ
77f0: 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 e, fileevents, f
7800: 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b lush on close} {
7810: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
7820: 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a t firstblock "".
7830: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
7840: 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 72 } {$i < 5} {incr
7850: 20 69 7d 20 7b 73 65 74 20 66 69 72 73 74 62 6c i} {set firstbl
7860: 6f 63 6b 20 22 61 24 66 69 72 73 74 62 6c 6f 63 ock "a$firstbloc
7870: 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 7d 0a 20 k$firstblock"}.
7880: 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f set secondblo
7890: 63 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 7b 73 ck "". for {s
78a0: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 36 et i 0} {$i < 16
78b0: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 73 65 } {incr i} {..se
78c0: 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 t secondblock "b
78d0: 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 $secondblock$sec
78e0: 6f 6e 64 62 6c 6f 63 6b 22 0a 20 20 20 20 7d 0a ondblock". }.
78f0: 20 20 20 20 73 65 74 20 6c 20 5b 74 6c 73 3a 3a set l [tls::
7900: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
7910: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
7920: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
7930: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
7940: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 Key \. .-serv
7950: 65 72 20 61 63 63 65 70 74 20 32 38 33 32 5d 0a er accept 2832].
7960: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
7970: 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 {s a p} {..fconf
7980: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
7990: 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f ng 0 -translatio
79a0: 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 n lf -buffersize
79b0: 20 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 16384 \...-buff
79c0: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 ering line..file
79d0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
79e0: 65 20 22 72 65 61 64 61 62 6c 65 20 24 73 22 0a e "readable $s".
79f0: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 }. proc r
7a00: 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 eadable {s} {..s
7a10: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
7a20: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
7a30: 64 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 dable {}..after
7a40: 31 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 1000 respond $s.
7a50: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 }. proc r
7a60: 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c espond {s} {..gl
7a70: 6f 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a obal firstblock.
7a80: 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 .puts -nonewline
7a90: 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a $s $firstblock.
7aa0: 09 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 .after 1000 writ
7ab0: 65 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 edata $s. }.
7ac0: 20 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 74 proc writedat
7ad0: 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 a {s} {..global
7ae0: 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 70 75 74 secondblock..put
7af0: 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 s -nonewline $s
7b00: 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c $secondblock..cl
7b10: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
7b20: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7b30: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
7b40: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
7b50: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7b60: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
7b70: 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f \. .[info ho
7b80: 73 74 6e 61 6d 65 5d 20 32 38 33 32 5d 0a 20 20 stname] 2832].
7b90: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 fconfigure $s
7ba0: 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 -blocking 0 -tra
7bb0: 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 ns lf -buffering
7bc0: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f line. set co
7bd0: 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 unt 0. puts $
7be0: 73 20 68 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 s hello. proc
7bf0: 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 readit {s} {..g
7c00: 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 lobal count done
7c10: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
7c20: 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 ]..incr count [s
7c30: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
7c40: 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 ..if {[eof $s]}
7c50: 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a {.. close $s.
7c60: 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a . set done 1.
7c70: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 66 69 6c .}. }. fil
7c80: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
7c90: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 20 le "readit $s".
7ca0: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
7cb0: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 64 ter 10000 "set d
7cc0: 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a one timed_out"].
7cd0: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
7ce0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
7cf0: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
7d00: 20 24 6c 0a 20 20 20 20 73 65 74 20 63 6f 75 6e $l. set coun
7d10: 74 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 t.} 65566..test
7d20: 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 65 73 74 69 tlsIO-9.3 {testi
7d30: 6e 67 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 ng EOF stickynes
7d40: 73 7d 20 7b 75 6e 65 78 70 6c 61 69 6e 65 64 48 s} {unexplainedH
7d50: 61 6e 67 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 ang socket} {.
7d60: 20 20 23 20 68 61 6e 67 73 0a 20 20 20 20 70 72 # hangs. pr
7d70: 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 oc count_to_eof
7d80: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f {s} {..global co
7d90: 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 unt done timer..
7da0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
7db0: 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b .if {[eof $s]} {
7dc0: 0a 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 .. incr count
7dd0: 0a 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 .. if {$count
7de0: 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 > 9} {...close
7df0: 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 72 $s...set done tr
7e00: 75 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 7b ue...set count {
7e10: 65 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 eof is sticky}..
7e20: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
7e30: 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 imer.. }..}.
7e40: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 }. proc ti
7e50: 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c merproc {} {..gl
7e60: 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 obal done count
7e70: 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 c..set done true
7e80: 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d ..set count {tim
7e90: 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 er went off, eof
7ea0: 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a is not sticky}.
7eb0: 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 09 .close $c. }.
7ec0: 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 . set count 0
7ed0: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 66 61 . set done fa
7ee0: 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 72 69 lse. proc wri
7ef0: 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 te_then_close {s
7f00: 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 79 65 } {..puts $s bye
7f10: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
7f20: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
7f30: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
7f40: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
7f50: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
7f60: 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 lation lf..filee
7f70: 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 vent $s writable
7f80: 20 22 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f "write_then_clo
7f90: 73 65 20 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 se $s". }.
7fa0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
7fb0: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
7fc0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
7fd0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7fe0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
7ff0: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
8000: 61 63 63 65 70 74 20 32 38 33 33 5d 0a 20 20 20 accept 2833].
8010: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
8020: 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 ket \..-certfile
8030: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
8040: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
8050: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
8060: 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 6f \. .[info ho
8070: 73 74 6e 61 6d 65 5d 20 32 38 33 33 5d 0a 20 20 stname] 2833].
8080: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 fconfigure $c
8090: 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 20 2d 62 -blocking off -b
80a0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 uffering line -t
80b0: 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 ranslation lf.
80c0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 fileevent $c r
80d0: 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 eadable "count_t
80e0: 6f 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 o_eof $c". se
80f0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
8100: 30 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 000 timerproc].
8110: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
8120: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
8130: 65 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 et count.} {eof
8140: 69 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f is sticky}..remo
8150: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 veFile script..t
8160: 65 73 74 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b est tlsIO-10.1 {
8170: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 testing socket a
8180: 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 ccept callback e
8190: 72 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b rror handling} {
81a0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
81b0: 74 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 t goterror 0.
81c0: 20 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 proc bgerror ar
81d0: 67 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 gs {global goter
81e0: 72 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 72 6f ror; set goterro
81f0: 72 20 31 7d 0a 20 20 20 20 73 65 74 20 73 20 5b r 1}. set s [
8200: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
8210: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
8220: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8230: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
8240: 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 erverKey \. .
8250: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 -server accept 2
8260: 38 39 38 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 898]. proc ac
8270: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c cept {s a p} {cl
8280: 6f 73 65 20 24 73 3b 20 65 72 72 6f 72 7d 0a 20 ose $s; error}.
8290: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
82a0: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
82b0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
82c0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
82d0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
82e0: 65 79 20 5c 0a 09 31 32 37 2e 30 2e 30 2e 31 20 ey \..127.0.0.1
82f0: 32 38 39 38 5d 0a 20 20 20 20 76 77 61 69 74 20 2898]. vwait
8300: 67 6f 74 65 72 72 6f 72 0a 20 20 20 20 63 6c 6f goterror. clo
8310: 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 se $s. close
8320: 24 63 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 $c. set goter
8330: 72 6f 72 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c ror.} 1..test tl
8340: 73 49 4f 2d 31 31 2e 31 20 7b 74 63 70 20 63 6f sIO-11.1 {tcp co
8350: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
8360: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
8370: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
8380: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
8390: 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 t caCert $caCert
83a0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
83b0: 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 d "set serverCer
83c0: 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 t $serverCert".
83d0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
83e0: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 set clientCert $
83f0: 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 clientCert".
8400: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8410: 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 serverKey $serv
8420: 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 erKey". sendC
8430: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
8440: 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 ntKey $clientKey
8450: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
8460: 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 d {..set socket9
8470: 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _1_test_server [
8480: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
8490: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d ver accept \...-
84a0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
84b0: 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 Cert \...-cafile
84c0: 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 $caCert \...-ke
84d0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
84e0: 20 5c 0a 09 09 32 38 33 34 5d 0a 09 70 72 6f 63 \...2834]..proc
84f0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
8500: 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 64 {.. puts $s d
8510: 6f 6e 65 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 one.. tls::ha
8520: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
8530: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
8540: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
8550: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
8560: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
8570: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
8580: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
8590: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
85a0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
85b0: 20 32 38 33 34 5d 0a 20 20 20 20 73 65 74 20 72 2834]. set r
85c0: 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 [gets $s]. c
85d0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 lose $s. send
85e0: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
85f0: 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 socket9_1_test_s
8600: 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 72 erver}. set r
8610: 0a 7d 20 64 6f 6e 65 0a 0a 74 65 73 74 20 74 6c .} done..test tl
8620: 73 49 4f 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 sIO-11.2 {client
8630: 20 73 70 65 63 69 66 69 65 73 20 69 74 73 20 70 specifies its p
8640: 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ort} {socket doT
8650: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
8660: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
8670: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 Command "set caC
8680: 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 ert $caCert".
8690: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
86a0: 74 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 t serverCert $se
86b0: 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 rverCert". se
86c0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
86d0: 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e lientCert $clien
86e0: 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 tCert". sendC
86f0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
8700: 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 erKey $serverKey
8710: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
8720: 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 d "set clientKey
8730: 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 $clientKey".
8740: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 if {[info exist
8750: 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e 63 72 s port]} {..incr
8760: 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 6c 73 65 port. } else
8770: 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 5b 65 78 {..set port [ex
8780: 70 72 20 32 30 34 38 20 2b 20 5b 70 69 64 5d 25 pr 2048 + [pid]%
8790: 31 30 32 34 5d 0a 20 20 20 20 7d 0a 20 20 20 20 1024]. }.
87a0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
87b0: 65 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 et socket9_2_tes
87c0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
87d0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
87e0: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
87f0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c le $serverCert \
8800: 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 ...-cafile $caCe
8810: 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 rt \...-keyfile
8820: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
8830: 20 20 32 38 33 35 5d 0a 09 70 72 6f 63 20 61 63 2835]..proc ac
8840: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
8850: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
8860: 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 ke $s.. puts
8870: 24 73 20 24 70 0a 09 20 20 20 20 63 6c 6f 73 65 $s $p.. close
8880: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
8890: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
88a0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
88b0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
88c0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
88d0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
88e0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 6d 79 70 tKey \.. -myp
88f0: 6f 72 74 20 24 70 6f 72 74 20 24 72 65 6d 6f 74 ort $port $remot
8900: 65 53 65 72 76 65 72 49 50 20 32 38 33 35 5d 0a eServerIP 2835].
8910: 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 set r [gets
8920: 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s]. close $s
8930: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8940: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 {close $socket9
8950: 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _2_test_server}.
8960: 20 20 20 20 69 66 20 7b 24 72 20 3d 3d 20 24 70 if {$r == $p
8970: 6f 72 74 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 ort} {..set resu
8980: 6c 74 20 6f 6b 0a 20 20 20 20 7d 20 65 6c 73 65 lt ok. } else
8990: 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 62 {..set result b
89a0: 72 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 20 20 roken. }.
89b0: 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 6f 6b 0a set result.} ok.
89c0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 33 20 test tlsIO-11.3
89d0: 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f 6e 6e 65 {trying to conne
89e0: 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 7d 20 7b ct, no server} {
89f0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8a00: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
8a10: 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 {. set status
8a20: 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 ok. if {![ca
8a30: 74 63 68 20 7b 73 65 74 20 73 20 5b 74 6c 73 3a tch {set s [tls:
8a40: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
8a50: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
8a60: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
8a70: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
8a80: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
8a90: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 70 20 $remoteServerIp
8aa0: 32 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 2836]}]} {..if {
8ab0: 21 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 ![catch {gets $s
8ac0: 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 }]} {.. set s
8ad0: 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a tatus broken..}.
8ae0: 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a .close $s. }.
8af0: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d set status.}
8b00: 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ok..test tlsIO-
8b10: 31 31 2e 34 20 7b 72 65 6d 6f 74 65 20 65 63 68 11.4 {remote ech
8b20: 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f o, one line} {so
8b30: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
8b40: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
8b50: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
8b60: 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 43 "set caCert $caC
8b70: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
8b80: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
8b90: 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 74 Cert $serverCert
8ba0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
8bb0: 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 72 d "set clientCer
8bc0: 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 t $clientCert".
8bd0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8be0: 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 73 set serverKey $s
8bf0: 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 65 erverKey". se
8c00: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
8c10: 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 lientKey $client
8c20: 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d Key". sendCom
8c30: 6d 61 6e 64 20 7b 0a 20 20 20 20 09 67 6c 6f 62 mand {. .glob
8c40: 61 6c 20 73 65 72 76 65 72 43 65 72 74 0a 09 67 al serverCert..g
8c50: 6c 6f 62 61 6c 20 63 61 43 65 72 74 0a 09 67 6c lobal caCert..gl
8c60: 6f 62 61 6c 20 73 65 72 76 65 72 4b 65 79 0a 09 obal serverKey..
8c70: 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 set socket10_6_t
8c80: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
8c90: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
8ca0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
8cb0: 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 t \...-cafile $c
8cc0: 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 aCert \...-keyfi
8cd0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8ce0: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
8cf0: 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 2836]..proc acc
8d00: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
8d10: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
8d20: 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 76 e $s.. fileev
8d30: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
8d40: 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 [list echo $s]..
8d50: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
8d60: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
8d70: 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 e -translation c
8d80: 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 rlf..}..proc ech
8d90: 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 o {s} {.. set
8da0: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 l [gets $s]..
8db0: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
8dc0: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 {...close $s..
8dd0: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 } else {...put
8de0: 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 s $s $l.. }..
8df0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
8e00: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c f [tls::socket \
8e10: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8e20: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
8e30: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8e40: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
8e50: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
8e60: 72 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 rverIP 2836].
8e70: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d fconfigure $f -
8e80: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
8e90: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
8ea0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 65 6c . puts $f hel
8eb0: 6c 6f 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 lo. set r [ge
8ec0: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
8ed0: 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $f. sendComm
8ee0: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
8ef0: 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 76 et10_6_test_serv
8f00: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
8f10: 68 65 6c 6c 6f 0a 0a 74 65 73 74 20 74 6c 73 49 hello..test tlsI
8f20: 4f 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 65 20 65 O-11.5 {remote e
8f30: 63 68 6f 2c 20 35 30 20 6c 69 6e 65 73 7d 20 7b cho, 50 lines} {
8f40: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8f50: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
8f60: 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e {. sendComman
8f70: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
8f80: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
8f90: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
8fa0: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
8fb0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8fc0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
8fd0: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
8fe0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8ff0: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
9000: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
9010: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
9020: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
9030: 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 ntKey". sendC
9040: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
9050: 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 cket10_7_test_se
9060: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
9070: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
9080: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
9090: 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d serverCert \...-
90a0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
90b0: 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 ...-keyfile $ser
90c0: 76 65 72 4b 65 79 20 5c 0a 09 09 32 38 33 36 5d verKey \...2836]
90d0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
90e0: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
90f0: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
9100: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
9110: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
9120: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
9130: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
9140: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
9150: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d nslation crlf..}
9160: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
9170: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
9180: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b ts $s].. if {
9190: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
91a0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
91b0: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 se {...puts $s $
91c0: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 l.. }..}.
91d0: 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 }. set f [tls
91e0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
91f0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
9200: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
9210: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9220: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9230: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9240: 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 2836]. fconf
9250: 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c igure $f -transl
9260: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 ation crlf -buff
9270: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 ering line. f
9280: 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 7d 20 7b or {set cnt 0} {
9290: 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 6e 63 72 $cnt < 50} {incr
92a0: 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 20 24 66 cnt} {..puts $f
92b0: 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 0a 09 "hello, $cnt"..
92c0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
92d0: 61 72 65 20 5b 67 65 74 73 20 24 66 5d 20 22 68 are [gets $f] "h
92e0: 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 21 3d 20 ello, $cnt"] !=
92f0: 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 61 6b 0a 0} {.. break.
9300: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f .}. }. clo
9310: 73 65 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f se $f. sendCo
9320: 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f mmand {close $so
9330: 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 cket10_7_test_se
9340: 72 76 65 72 7d 0a 20 20 20 20 73 65 74 20 63 6e rver}. set cn
9350: 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 69 6e 74 t.} 50..# Macint
9360: 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 61 6e 20 osh sockets can
9370: 68 61 76 65 20 6d 6f 72 65 20 74 68 61 6e 20 6f have more than o
9380: 6e 65 20 73 65 72 76 65 72 20 70 65 72 20 70 6f ne server per po
9390: 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 6c 61 74 rt.if {$tcl_plat
93a0: 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 3d form(platform) =
93b0: 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 7d 20 7b = "macintosh"} {
93c0: 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 . set conflic
93d0: 74 52 65 73 75 6c 74 20 7b 30 20 32 38 33 36 7d tResult {0 2836}
93e0: 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 73 65 .} else {. se
93f0: 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 t conflictResult
9400: 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 {1 {couldn't op
9410: 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 en socket: addre
9420: 73 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 ss already in us
9430: 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 e}}.}..test tlsI
9440: 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 74 20 63 O-11.6 {socket c
9450: 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 onflict} {socket
9460: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
9470: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
9480: 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 set s1 [tls::soc
9490: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
94a0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
94b0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
94c0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
94d0: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
94e0: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d ver accept 2836]
94f0: 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
9500: 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f {set s2 [tls::so
9510: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
9520: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
9530: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
9540: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
9550: 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 erKey \.. -se
9560: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
9570: 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 ]} msg]} {..set
9580: 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 31 20 24 result [list 1 $
9590: 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 73 65 20 msg]. } else
95a0: 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c {..set result [l
95b0: 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 20 5b 66 ist 0 [lindex [f
95c0: 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 2d 73 configure $s2 -s
95d0: 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a 09 63 6c ockname] 2]]..cl
95e0: 6f 73 65 20 24 73 32 0a 20 20 20 20 7d 0a 20 20 ose $s2. }.
95f0: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
9600: 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 24 63 6f set result.} $co
9610: 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a 0a 74 65 nflictResult..te
9620: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 37 20 7b 73 st tlsIO-11.7 {s
9630: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
9640: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 al clients} {soc
9650: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9660: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9670: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
9680: 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 5f 39 ..set socket10_9
9690: 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c _test_server [tl
96a0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 s::socket \...-c
96b0: 65 72 74 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f ertfile [file jo
96c0: 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 in [pwd] certs s
96d0: 65 72 76 65 72 2e 70 65 6d 5d 20 5c 0a 09 09 2d erver.pem] \...-
96e0: 63 61 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 cafile [file joi
96f0: 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 63 61 n [pwd] certs ca
9700: 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a 09 09 2d 6b File.pem] \...-k
9710: 65 79 66 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 eyfile [file joi
9720: 6e 20 5b 70 77 64 5d 20 63 65 72 74 73 20 73 6b n [pwd] certs sk
9730: 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 2d 73 65 72 ey.pem] \...-ser
9740: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d ver accept 2836]
9750: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
9760: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 23 20 68 a p} {.. # h
9770: 61 6e 64 73 68 61 6b 65 20 6c 6f 63 6b 73 20 75 andshake locks u
9780: 70 20 74 68 65 20 74 68 72 65 65 20 73 79 6e 63 p the three sync
9790: 68 72 6f 6e 6f 75 73 20 63 6c 69 65 6e 74 73 0a hronous clients.
97a0: 09 20 20 20 20 23 20 74 6c 73 3a 3a 68 61 6e 64 . # tls::hand
97b0: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 63 shake $s.. fc
97c0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
97d0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
97e0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
97f0: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
9800: 6f 20 24 73 5d 0a 09 7d 0a 09 70 72 6f 63 20 65 o $s]..}..proc e
9810: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 cho {s} {.. s
9820: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
9830: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
9840: 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 } {...close $s..
9850: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 } else {...p
9860: 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d uts $s $l.. }
9870: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
9880: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
9890: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
98a0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
98b0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
98c0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
98d0: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
98e0: 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a eServerIP 2836].
98f0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
9900: 73 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s1 -buffering li
9910: 6e 65 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 ne. set s2 [t
9920: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9930: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9940: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9950: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9960: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
9970: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
9980: 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f IP 2836]. fco
9990: 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 75 66 nfigure $s2 -buf
99a0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
99b0: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
99c0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
99d0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
99e0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
99f0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
9a00: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
9a10: 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 oteServerIP 2836
9a20: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
9a30: 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 $s3 -buffering
9a40: 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 line. for {se
9a50: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 t i 0} {$i < 100
9a60: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 } {incr i} {..pu
9a70: 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 73 31 0a ts $s1 hello,s1.
9a80: 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 .gets $s1..puts
9a90: 24 73 32 20 68 65 6c 6c 6f 2c 73 32 0a 09 67 65 $s2 hello,s2..ge
9aa0: 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 ts $s2..puts $s3
9ab0: 20 68 65 6c 6c 6f 2c 73 33 0a 09 67 65 74 73 20 hello,s3..gets
9ac0: 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $s3. }. cl
9ad0: 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 ose $s1. clos
9ae0: 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $s2. close
9af0: 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d $s3. sendComm
9b00: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
9b10: 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 et10_9_test_serv
9b20: 65 72 7d 0a 20 20 20 20 73 65 74 20 69 0a 7d 20 er}. set i.}
9b30: 31 30 30 20 20 20 20 0a 0a 74 65 73 74 20 74 6c 100 ..test tl
9b40: 73 49 4f 2d 31 31 2e 38 20 7b 63 6c 69 65 6e 74 sIO-11.8 {client
9b50: 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 73 65 with several se
9b60: 72 76 65 72 73 7d 20 7b 75 6e 65 78 70 6c 61 69 rvers} {unexplai
9b70: 6e 65 64 48 61 6e 67 20 73 6f 63 6b 65 74 20 64 nedHang socket d
9b80: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
9b90: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 Server} {. #
9ba0: 74 68 69 73 20 6f 6e 65 20 73 65 65 6d 73 20 74 this one seems t
9bb0: 6f 20 68 61 6e 67 20 2d 2d 20 61 77 62 20 36 2f o hang -- awb 6/
9bc0: 32 2f 32 30 30 30 0a 20 20 20 20 73 65 6e 64 43 2/2000. sendC
9bd0: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 31 ommand {..set s1
9be0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9bf0: 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c ..-certfile [fil
9c00: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
9c10: 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c ts server.pem] \
9c20: 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 ...-cafile [file
9c30: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9c40: 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a s caFile.pem] \.
9c50: 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 ..-keyfile [file
9c60: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9c70: 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 s skey.pem] \...
9c80: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
9c90: 34 30 30 33 22 20 34 30 30 33 5d 0a 09 73 65 74 4003" 4003]..set
9ca0: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
9cb0: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 5b \...-certfile [
9cc0: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9cd0: 63 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 6d certs server.pem
9ce0: 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 ] \...-cafile [f
9cf0: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9d00: 65 72 74 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d erts caFile.pem]
9d10: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 \...-keyfile [f
9d20: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9d30: 65 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c erts skey.pem] \
9d40: 0a 09 09 2d 73 65 72 76 65 72 20 22 61 63 63 65 ...-server "acce
9d50: 70 74 20 34 30 30 34 22 20 34 30 30 34 5d 0a 09 pt 4004" 4004]..
9d60: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
9d70: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
9d80: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
9d90: 64 5d 20 63 65 72 74 73 20 73 65 72 76 65 72 2e d] certs server.
9da0: 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 pem] \...-cafile
9db0: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 [file join [pwd
9dc0: 5d 20 63 65 72 74 73 20 63 61 46 69 6c 65 2e 70 ] certs caFile.p
9dd0: 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 em] \...-keyfile
9de0: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 [file join [pwd
9df0: 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 65 6d ] certs skey.pem
9e00: 5d 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 22 61 ] \...-server "a
9e10: 63 63 65 70 74 20 34 30 30 35 22 20 34 30 30 35 ccept 4005" 4005
9e20: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
9e30: 6d 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 mp s a p} {..
9e40: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
9e50: 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 $s.. puts $s
9e60: 24 6d 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 $mp.. close $
9e70: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
9e80: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
9e90: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
9ea0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
9eb0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9ec0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
9ed0: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
9ee0: 74 65 53 65 72 76 65 72 49 50 20 34 30 30 33 5d teServerIP 4003]
9ef0: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
9f00: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9f10: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
9f20: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
9f30: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9f40: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9f50: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9f60: 20 34 30 30 34 5d 0a 20 20 20 20 73 65 74 20 73 4004]. set s
9f70: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 3 [tls::socket \
9f80: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9f90: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9fa0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9fb0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
9fc0: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
9fd0: 72 76 65 72 49 50 20 34 30 30 35 5d 0a 20 20 20 rverIP 4005].
9fe0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
9ff0: 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 ppend l [gets $s
a000: 31 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 1] [gets $s1] [e
a010: 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 of $s1] [gets $s
a020: 32 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 2] [gets $s2] [e
a030: 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 of $s2] \..[gets
a040: 20 24 73 33 5d 20 5b 67 65 74 73 20 24 73 33 5d $s3] [gets $s3]
a050: 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 [eof $s3]. c
a060: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f lose $s1. clo
a070: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
a080: 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d $s3. sendCom
a090: 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 mand {..close $s
a0a0: 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 1..close $s2..cl
a0b0: 6f 73 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ose $s3. }.
a0c0: 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 set l.} {4003
a0d0: 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 20 34 {} 1 4004 {} 1 4
a0e0: 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 005 {} 1}..test
a0f0: 74 6c 73 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 tlsIO-11.9 {acce
a100: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
a110: 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 r} {socket doTes
a120: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a130: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 er} {. set s
a140: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a150: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
a160: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
a170: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a180: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
a190: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
a1a0: 65 70 74 20 32 38 33 36 5d 0a 20 20 20 20 70 72 ept 2836]. pr
a1b0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
a1c0: 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a } {expr 10 / 0}.
a1d0: 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 proc bgerror
a1e0: 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 args {..global
a1f0: 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 x..set x $args.
a200: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d }. sendCom
a210: 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 mand "set caCert
a220: 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 $caCert". se
a230: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
a240: 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 erverCert $serve
a250: 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 rCert". sendC
a260: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
a270: 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 ntCert $clientCe
a280: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
a290: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b and "set serverK
a2a0: 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 ey $serverKey".
a2b0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a2c0: 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 set clientKey $c
a2d0: 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 69 66 lientKey". if
a2e0: 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f {[catch {sendCo
a2f0: 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 mmand {.. set
a300: 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 peername [fconf
a310: 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 igure $callerSoc
a320: 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 ket -peername]..
a330: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
a340: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
a350: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
a360: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 \...-cafile $ca
a370: 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c Cert \...-keyfil
a380: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
a390: 20 20 20 20 09 5b 6c 69 6e 64 65 78 20 24 70 65 .[lindex $pe
a3a0: 65 72 6e 61 6d 65 20 30 5d 20 32 38 33 36 5d 0a ername 0] 2836].
a3b0: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
a3c0: 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 . }} msg]} {..
a3d0: 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 close $s..error
a3e0: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
a3f0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
a400: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
a410: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
a420: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
a430: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
a440: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 close $s. re
a450: 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a name bgerror {}.
a460: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 set x.} {{di
a470: 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a vide by zero}}..
a480: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 test tlsIO-11.10
a490: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
a4a0: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
a4b0: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
a4c0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a4d0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
a4e0: 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 mmand "set caCer
a4f0: 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 t $caCert". s
a500: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
a510: 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 serverCert $serv
a520: 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 erCert". send
a530: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
a540: 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 entCert $clientC
a550: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a560: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
a570: 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a Key $serverKey".
a580: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a590: 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 "set clientKey $
a5a0: 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 clientKey". s
a5b0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
a5c0: 74 20 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 t socket10_12_te
a5d0: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
a5e0: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
a5f0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
a600: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 \...-cafile $ca
a610: 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c Cert \...-keyfil
a620: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
a630: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
a640: 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 2836]..proc acce
a650: 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 pt {s a p} {clos
a660: 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 e $s}. }.
a670: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
a680: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
a690: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
a6a0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a6b0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a6c0: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
a6d0: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d teServerIP 2836]
a6e0: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
a6f0: 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e figure $s -peern
a700: 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b ame]. set n [
a710: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
a720: 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 ockname]. set
a730: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
a740: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 d l [lindex $p 2
a750: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b ] [llength $p] [
a760: 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 llength $p].
a770: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e close $s. sen
a780: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
a790: 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 $socket10_12_tes
a7a0: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
a7b0: 74 20 6c 0a 7d 20 7b 32 38 33 36 20 33 20 33 7d t l.} {2836 3 3}
a7c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
a7d0: 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 11 {testing spur
a7e0: 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 75 6e ious events} {un
a7f0: 65 78 70 6c 61 69 6e 65 64 48 61 6e 67 20 73 6f explainedHang so
a800: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
a810: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
a820: 20 20 20 20 23 20 68 61 6e 67 73 0a 20 20 20 20 # hangs.
a830: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a840: 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 caCert $caCert"
a850: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a860: 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 "set serverCert
a870: 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 $serverCert".
a880: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
a890: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 et clientCert $c
a8a0: 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 lientCert". s
a8b0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
a8c0: 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 serverKey $serve
a8d0: 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f rKey". sendCo
a8e0: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
a8f0: 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 tKey $clientKey"
a900: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a910: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
a920: 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 65 72 20 _13_test_server
a930: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a940: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
a950: 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 erCert \...-cafi
a960: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d le $caCert \...-
a970: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
a980: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
a990: 63 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f ccept 2836]..pro
a9a0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
a9b0: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
a9c0: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 dshake $s.. f
a9d0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
a9e0: 61 6e 73 6c 61 74 69 6f 6e 20 22 61 75 74 6f 20 anslation "auto
a9f0: 6c 66 22 0a 09 20 20 20 20 61 66 74 65 72 20 31 lf".. after 1
aa00: 30 30 20 77 72 69 74 65 73 6f 6d 65 20 24 73 0a 00 writesome $s.
aa10: 09 7d 0a 09 70 72 6f 63 20 77 72 69 74 65 73 6f .}..proc writeso
aa20: 6d 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 66 6f me {s} {.. fo
aa30: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
aa40: 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 < 100} {incr i}
aa50: 7b 0a 09 09 70 75 74 73 20 24 73 20 22 6c 69 6e {...puts $s "lin
aa60: 65 20 24 69 20 66 72 6f 6d 20 72 65 6d 6f 74 65 e $i from remote
aa70: 20 73 65 72 76 65 72 22 0a 09 20 20 20 20 7d 0a server".. }.
aa80: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d . close $s..}
aa90: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c . }. set l
aaa0: 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 en 0. set spu
aab0: 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 rious 0. set
aac0: 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 done 0. proc
aad0: 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b readlittle {s} {
aae0: 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 ..global spuriou
aaf0: 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 s done len..set
ab00: 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 l [read $s 1]..i
ab10: 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 f {[string lengt
ab20: 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 h $l] == 0} {..
ab30: 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d if {![eof $s]
ab40: 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 } {...incr spuri
ab50: 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ous.. } else
ab60: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 {...close $s...s
ab70: 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d et done 1.. }
ab80: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
ab90: 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 incr len [string
aba0: 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 length $l]..}.
abb0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b }. set c [
abc0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
abd0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
abe0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
abf0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
ac00: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
ac10: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
ac20: 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 69 rIP 2836]. fi
ac30: 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 leevent $c reada
ac40: 62 6c 65 20 22 72 65 61 64 6c 69 74 74 6c 65 20 ble "readlittle
ac50: 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c". set time
ac60: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
ac70: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
ac80: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
ac90: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
aca0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
acb0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
acc0: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 33 5f se $socket10_13_
acd0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
ace0: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
acf0: 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a $len.} {0 2690}.
ad00: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
ad10: 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 2 {testing EOF s
ad20: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 73 6f 63 6b tickyness} {sock
ad30: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
ad40: 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 moteServer} {.
ad50: 20 20 73 65 74 20 63 6f 75 6e 74 65 72 20 30 0a set counter 0.
ad60: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 set done 0.
ad70: 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 75 70 proc count_up
ad80: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
ad90: 6f 75 6e 74 65 72 20 64 6f 6e 65 20 61 66 74 65 ounter done afte
ada0: 72 5f 69 64 0a 09 73 65 74 20 6c 20 5b 67 65 74 r_id..set l [get
adb0: 73 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 s $s]..if {[eof
adc0: 24 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 $s]} {.. incr
add0: 20 63 6f 75 6e 74 65 72 0a 09 20 20 20 20 69 66 counter.. if
ade0: 20 7b 24 63 6f 75 6e 74 65 72 20 3e 20 39 7d 20 {$counter > 9}
adf0: 7b 0a 09 09 73 65 74 20 64 6f 6e 65 20 7b 45 4f {...set done {EO
ae00: 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 61 F is sticky}...a
ae10: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 61 66 74 fter cancel $aft
ae20: 65 72 5f 69 64 0a 09 09 63 6c 6f 73 65 20 24 73 er_id...close $s
ae30: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
ae40: 0a 20 20 20 20 70 72 6f 63 20 74 69 6d 65 64 5f . proc timed_
ae50: 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c out {} {..global
ae60: 20 63 20 64 6f 6e 65 0a 09 73 65 74 20 64 6f 6e c done..set don
ae70: 65 20 7b 74 69 6d 65 64 5f 6f 75 74 2c 20 45 4f e {timed_out, EO
ae80: 46 20 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d F is not sticky}
ae90: 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d ..close $c. }
aea0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
aeb0: 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 61 "set caCert $ca
aec0: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
aed0: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
aee0: 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 72 rCert $serverCer
aef0: 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 t". sendComma
af00: 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 65 nd "set clientCe
af10: 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 0a rt $clientCert".
af20: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
af30: 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 24 "set serverKey $
af40: 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 73 serverKey". s
af50: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
af60: 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 6e clientKey $clien
af70: 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f tKey". sendCo
af80: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
af90: 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 ket10_14_test_se
afa0: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
afb0: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
afc0: 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 $serverCert \...
afd0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
afe0: 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 \...-keyfile $se
aff0: 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 rverKey \...-ser
b000: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d ver accept 2836]
b010: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
b020: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
b030: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
b040: 20 20 20 20 61 66 74 65 72 20 31 30 30 20 63 6c after 100 cl
b050: 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ose $s..}. }.
b060: 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a set c [tls::
b070: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
b080: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
b090: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
b0a0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
b0b0: 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 24 ientKey \. .$
b0c0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 remoteServerIP 2
b0d0: 38 33 36 5d 0a 20 20 20 20 66 69 6c 65 65 76 65 836]. fileeve
b0e0: 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 22 nt $c readable "
b0f0: 63 6f 75 6e 74 5f 75 70 20 24 63 22 0a 20 20 20 count_up $c".
b100: 20 73 65 74 20 61 66 74 65 72 5f 69 64 20 5b 61 set after_id [a
b110: 66 74 65 72 20 31 30 30 30 20 74 69 6d 65 64 5f fter 1000 timed_
b120: 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 20 64 out]. vwait d
b130: 6f 6e 65 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d one. sendComm
b140: 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b and {close $sock
b150: 65 74 31 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 et10_14_test_ser
b160: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 64 6f 6e ver}. set don
b170: 65 0a 7d 20 7b 45 4f 46 20 69 73 20 73 74 69 63 e.} {EOF is stic
b180: 6b 79 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ky}..test tlsIO-
b190: 31 31 2e 31 33 20 7b 74 65 73 74 69 6e 67 20 61 11.13 {testing a
b1a0: 73 79 6e 63 20 77 72 69 74 65 2c 20 61 73 79 6e sync write, asyn
b1b0: 63 20 66 6c 75 73 68 2c 20 61 73 79 6e 63 20 63 c flush, async c
b1c0: 6c 6f 73 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 lose} \..{socket
b1d0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
b1e0: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
b1f0: 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 proc readit {s}
b200: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 {..global count
b210: 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 61 done..set l [rea
b220: 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 6e d $s]..incr coun
b230: 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 t [string length
b240: 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 $l]..if {[eof $
b250: 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 s]} {.. close
b260: 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f 6e $s.. set don
b270: 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 e 1..}. }.
b280: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
b290: 74 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 t caCert $caCert
b2a0: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
b2b0: 64 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 d "set serverCer
b2c0: 74 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 t $serverCert".
b2d0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
b2e0: 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 set clientCert $
b2f0: 63 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 clientCert".
b300: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
b310: 20 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 serverKey $serv
b320: 65 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 erKey". sendC
b330: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
b340: 6e 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 ntKey $clientKey
b350: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
b360: 64 20 7b 0a 09 73 65 74 20 66 69 72 73 74 62 6c d {..set firstbl
b370: 6f 63 6b 20 22 22 0a 09 66 6f 72 20 7b 73 65 74 ock ""..for {set
b380: 20 69 20 30 7d 20 7b 24 69 20 3c 20 35 7d 20 7b i 0} {$i < 5} {
b390: 69 6e 63 72 20 69 7d 20 7b 0a 09 09 73 65 74 20 incr i} {...set
b3a0: 66 69 72 73 74 62 6c 6f 63 6b 20 22 61 24 66 69 firstblock "a$fi
b3b0: 72 73 74 62 6c 6f 63 6b 24 66 69 72 73 74 62 6c rstblock$firstbl
b3c0: 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 73 65 63 ock"..}..set sec
b3d0: 6f 6e 64 62 6c 6f 63 6b 20 22 22 0a 09 66 6f 72 ondblock ""..for
b3e0: 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c {set i 0} {$i <
b3f0: 20 31 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 16} {incr i} {.
b400: 09 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 . set secondb
b410: 6c 6f 63 6b 20 22 62 24 73 65 63 6f 6e 64 62 6c lock "b$secondbl
b420: 6f 63 6b 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 22 ock$secondblock"
b430: 0a 09 7d 0a 09 73 65 74 20 6c 20 5b 74 6c 73 3a ..}..set l [tls:
b440: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
b450: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
b460: 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 t \...-cafile $c
b470: 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 aCert \...-keyfi
b480: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
b490: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
b4a0: 20 32 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 2845]..proc acc
b4b0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
b4c0: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
b4d0: 65 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 e $s.. fconfi
b4e0: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
b4f0: 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e g 0 -translation
b500: 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 lf -buffersize
b510: 31 36 33 38 34 20 5c 0a 09 09 2d 62 75 66 66 65 16384 \...-buffe
b520: 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 20 66 ring line.. f
b530: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
b540: 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 24 able "readable $
b550: 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 65 61 64 s"..}..proc read
b560: 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 able {s} {..
b570: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
b580: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b590: 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 20 s readable {}..
b5a0: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 72 65 after 1000 re
b5b0: 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 72 6f spond $s..}..pro
b5c0: 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a c respond {s} {.
b5d0: 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 69 72 73 . global firs
b5e0: 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 74 73 tblock.. puts
b5f0: 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 -nonewline $s $
b600: 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 firstblock..
b610: 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 65 after 1000 write
b620: 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 72 6f 63 data $s..}..proc
b630: 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d 20 7b writedata {s} {
b640: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 65 63 .. global sec
b650: 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 ondblock.. pu
b660: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
b670: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 $secondblock..
b680: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
b690: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
b6a0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
b6b0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
b6c0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
b6d0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
b6e0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
b6f0: 20 20 20 09 24 72 65 6d 6f 74 65 53 65 72 76 65 .$remoteServe
b700: 72 49 50 20 32 38 34 35 5d 0a 20 20 20 20 66 63 rIP 2845]. fc
b710: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f onfigure $s -blo
b720: 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c cking 0 -trans l
b730: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
b740: 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 e. set count
b750: 30 0a 20 20 20 20 70 75 74 73 20 24 73 20 68 65 0. puts $s he
b760: 6c 6c 6f 0a 20 20 20 20 66 69 6c 65 65 76 65 6e llo. fileeven
b770: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
b780: 65 61 64 69 74 20 24 73 22 0a 20 20 20 20 73 65 eadit $s". se
b790: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
b7a0: 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 0000 "set done t
b7b0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
b7c0: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 wait done. af
b7d0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
b7e0: 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e r. sendComman
b7f0: 64 20 7b 63 6c 6f 73 65 20 24 6c 7d 0a 20 20 20 d {close $l}.
b800: 20 73 65 74 20 63 6f 75 6e 74 0a 7d 20 36 35 35 set count.} 655
b810: 36 36 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 66..test tlsIO-1
b820: 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 2.1 {testing inh
b830: 65 72 69 74 61 6e 63 65 20 6f 66 20 73 65 72 76 eritance of serv
b840: 65 72 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b er sockets} \..{
b850: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
b860: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
b870: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
b880: 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d script1. rem
b890: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a oveFile script2.
b8a0: 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 69 . # Script1 i
b8b0: 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f s just a 10 seco
b8c0: 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 nd delay. If th
b8d0: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a e server socket.
b8e0: 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 # is inherit
b8f0: 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 ed, it will be h
b900: 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 eld open for 10
b910: 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 seconds.. set
b920: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 f [open script1
b930: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
b940: 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 {..after 10000 e
b950: 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 xit..vwait forev
b960: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
b970: 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 se $f.. # Scr
b980: 69 70 74 32 20 63 72 65 61 74 65 73 20 74 68 65 ipt2 creates the
b990: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c 20 server socket,
b9a0: 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 launches script1
b9b0: 2c 0a 20 20 20 20 23 20 77 61 69 74 73 20 61 20 ,. # waits a
b9c0: 73 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 74 second, and exit
b9d0: 73 2e 20 20 54 68 65 20 73 65 72 76 65 72 20 73 s. The server s
b9e0: 6f 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 ocket will now.
b9f0: 20 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20 75 # be closed u
ba00: 6e 6c 65 73 73 20 73 63 72 69 70 74 31 20 69 6e nless script1 in
ba10: 68 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 20 herited it...
ba20: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
ba30: 69 70 74 32 20 77 5d 0a 20 20 20 20 23 20 70 75 ipt2 w]. # pu
ba40: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
ba50: 74 63 6c 74 65 73 74 20 24 3a 3a 74 63 6c 74 65 tcltest $::tclte
ba60: 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 st::tcltest].
ba70: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
ba80: 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 6e et tclsh [info n
ba90: 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d ameofexecutable]
baa0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
bab0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
bac0: 20 74 63 6c 74 65 73 74 0a 09 70 61 63 6b 61 67 tcltest..packag
bad0: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 e require tls.
bae0: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
baf0: 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f "set f \[tls::so
bb00: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
bb10: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
bb20: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
bb30: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
bb40: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 le $serverKey 28
bb50: 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 28 \]". puts
bb60: 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 $f {..proc accep
bb70: 74 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 6f t { file addr po
bb80: 72 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 rt } {.. clos
bb90: 65 20 24 66 69 6c 65 0a 09 7d 0a 09 23 20 65 78 e $file..}..# ex
bba0: 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 ec $::tcltest::t
bbb0: 63 6c 74 65 73 74 20 73 63 72 69 70 74 31 20 26 cltest script1 &
bbc0: 0a 09 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 ..exec $tclsh sc
bbd0: 72 69 70 74 31 20 26 0a 09 63 6c 6f 73 65 20 24 ript1 &..close $
bbe0: 66 0a 09 61 66 74 65 72 20 31 30 30 30 20 65 78 f..after 1000 ex
bbf0: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
bc00: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
bc10: 65 20 24 66 0a 09 0a 20 20 20 20 23 20 4c 61 75 e $f... # Lau
bc20: 6e 63 68 20 73 63 72 69 70 74 32 20 61 6e 64 20 nch script2 and
bc30: 77 61 69 74 20 35 20 73 65 63 6f 6e 64 73 0a 0a wait 5 seconds..
bc40: 20 20 20 20 23 20 65 78 65 63 20 24 3a 3a 74 63 # exec $::tc
bc50: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
bc60: 63 72 69 70 74 32 20 26 0a 20 20 20 20 65 78 65 cript2 &. exe
bc70: 63 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 c [info nameofex
bc80: 65 63 75 74 61 62 6c 65 5d 20 73 63 72 69 70 74 ecutable] script
bc90: 32 20 26 0a 20 20 20 20 61 66 74 65 72 20 35 30 2 &. after 50
bca0: 30 30 20 7b 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 00 { set ok_to_p
bcb0: 72 6f 63 65 65 64 20 31 20 7d 0a 20 20 20 20 76 roceed 1 }. v
bcc0: 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 wait ok_to_proce
bcd0: 65 64 0a 0a 20 20 20 20 23 20 49 66 20 77 65 20 ed.. # If we
bce0: 63 61 6e 20 73 74 69 6c 6c 20 63 6f 6e 6e 65 63 can still connec
bcf0: 74 20 74 6f 20 74 68 65 20 73 65 72 76 65 72 2c t to the server,
bd00: 20 74 68 65 20 73 6f 63 6b 65 74 20 67 6f 74 20 the socket got
bd10: 69 6e 68 65 72 69 74 65 64 2e 0a 0a 20 20 20 20 inherited...
bd20: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
bd30: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
bd40: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
bd50: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
bd60: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
bd70: 74 4b 65 79 20 5c 0a 20 20 20 09 20 31 32 37 2e tKey \. . 127.
bd80: 30 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 5d 0.0.1 2828} msg]
bd90: 7d 20 7b 0a 09 73 65 74 20 78 20 7b 73 65 72 76 } {..set x {serv
bda0: 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f er socket was no
bdb0: 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 t inherited}.
bdc0: 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 } else {..close
bdd0: 20 24 6d 73 67 0a 09 73 65 74 20 78 20 7b 73 65 $msg..set x {se
bde0: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 rver socket was
bdf0: 69 6e 68 65 72 69 74 65 64 7d 0a 20 20 20 20 7d inherited}. }
be00: 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 .. removeFile
be10: 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d script1. rem
be20: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a oveFile script2.
be30: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 73 65 72 set x.} {ser
be40: 76 65 72 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ver socket was n
be50: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 ot inherited}..t
be60: 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 32 20 7b est tlsIO-12.2 {
be70: 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 testing inherita
be80: 6e 63 65 20 6f 66 20 63 6c 69 65 6e 74 20 73 6f nce of client so
be90: 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 ckets} \..{socke
bea0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
beb0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
bec0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
bed0: 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 pt1. removeFi
bee0: 6c 65 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 le script2..
bef0: 23 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 # Script1 is jus
bf00: 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 t a 10 second de
bf10: 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 lay. If the ser
bf20: 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 ver socket. #
bf30: 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 is inherited, i
bf40: 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f t will be held o
bf50: 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e pen for 10 secon
bf60: 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f ds.. set f [o
bf70: 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 pen script1 w].
bf80: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 puts $f {..af
bf90: 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 ter 10000 exit..
bfa0: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
bfb0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
bfc0: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 .. # Script2
bfd0: 6f 70 65 6e 73 20 74 68 65 20 63 6c 69 65 6e 74 opens the client
bfe0: 20 73 6f 63 6b 65 74 20 61 6e 64 20 77 72 69 74 socket and writ
bff0: 65 73 20 74 6f 20 69 74 2e 20 20 49 74 20 74 68 es to it. It th
c000: 65 6e 0a 20 20 20 20 23 20 6c 61 75 6e 63 68 65 en. # launche
c010: 73 20 73 63 72 69 70 74 31 20 61 6e 64 20 65 78 s script1 and ex
c020: 69 74 73 2e 20 20 49 66 20 74 68 65 20 63 68 69 its. If the chi
c030: 6c 64 20 70 72 6f 63 65 73 73 20 69 6e 68 65 72 ld process inher
c040: 69 74 65 64 20 74 68 65 0a 20 20 20 20 23 20 63 ited the. # c
c050: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2c 20 74 68 lient socket, th
c060: 65 20 73 6f 63 6b 65 74 20 77 69 6c 6c 20 73 74 e socket will st
c070: 69 6c 6c 20 62 65 20 6f 70 65 6e 2e 0a 0a 20 20 ill be open...
c080: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
c090: 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 ript2 w]. put
c0a0: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 s $f [list set t
c0b0: 63 6c 73 68 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f clsh [info nameo
c0c0: 66 65 78 65 63 75 74 61 62 6c 65 5d 5d 0a 20 20 fexecutable]].
c0d0: 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 puts $f {.
c0e0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
c0f0: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
c100: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
c110: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
c120: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
c130: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
c140: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
c150: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
c160: 32 38 32 39 20 5c 5d 22 0a 20 20 20 20 70 75 74 2829 \]". put
c170: 73 20 24 66 20 7b 0a 09 65 78 65 63 20 24 74 63 s $f {..exec $tc
c180: 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 70 lsh script1 &..p
c190: 75 74 73 20 24 66 20 74 65 73 74 69 6e 67 0a 09 uts $f testing..
c1a0: 66 6c 75 73 68 20 24 66 0a 09 61 66 74 65 72 20 flush $f..after
c1b0: 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 1000 exit..vwait
c1c0: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
c1d0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
c1e0: 20 23 20 43 72 65 61 74 65 20 74 68 65 20 73 65 # Create the se
c1f0: 72 76 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 20 rver socket..
c200: 20 73 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 set server [tls
c210: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
c220: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
c230: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
c240: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
c250: 65 72 4b 65 79 20 5c 0a 09 2d 73 65 72 76 65 72 erKey \..-server
c260: 20 61 63 63 65 70 74 20 32 38 32 39 5d 0a 20 20 accept 2829].
c270: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 proc accept {
c280: 66 69 6c 65 20 68 6f 73 74 20 70 6f 72 74 20 7d file host port }
c290: 20 7b 0a 0a 09 23 20 57 68 65 6e 20 74 68 65 20 {...# When the
c2a0: 63 6c 69 65 6e 74 20 63 6f 6e 6e 65 63 74 73 2c client connects,
c2b0: 20 65 73 74 61 62 6c 69 73 68 20 74 68 65 20 72 establish the r
c2c0: 65 61 64 20 68 61 6e 64 6c 65 72 0a 09 67 6c 6f ead handler..glo
c2d0: 62 61 6c 20 73 65 72 76 65 72 0a 09 63 6c 6f 73 bal server..clos
c2e0: 65 20 24 73 65 72 76 65 72 0a 09 66 69 6c 65 65 e $server..filee
c2f0: 76 65 6e 74 20 24 66 69 6c 65 20 72 65 61 64 61 vent $file reada
c300: 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 ble [list getdat
c310: 61 20 24 66 69 6c 65 5d 0a 09 66 63 6f 6e 66 69 a $file]..fconfi
c320: 67 75 72 65 20 24 66 69 6c 65 20 2d 62 75 66 66 gure $file -buff
c330: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 62 6c 6f 63 ering line -bloc
c340: 6b 69 6e 67 20 30 0a 09 72 65 74 75 72 6e 0a 20 king 0..return.
c350: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 67 65 }. proc ge
c360: 74 64 61 74 61 20 7b 20 66 69 6c 65 20 7d 20 7b tdata { file } {
c370: 0a 0a 09 23 20 52 65 61 64 20 68 61 6e 64 6c 65 ...# Read handle
c380: 72 20 6f 6e 20 74 68 65 20 61 63 63 65 70 74 65 r on the accepte
c390: 64 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 d socket...globa
c3a0: 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c l x..global fail
c3b0: 65 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b ed..set status [
c3c0: 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c catch {read $fil
c3d0: 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 e} data]..if {$s
c3e0: 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 tatus != 0} {..
c3f0: 20 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 66 set x {read f
c400: 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 ailed, error was
c410: 20 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 74 $data}.. cat
c420: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
c430: 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 }..} elseif {[s
c440: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d tring compare {}
c450: 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c $data]} {..} el
c460: 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 seif {[fblocked
c470: 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 $file]} {..} els
c480: 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d eif {[eof $file]
c490: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 } {.. if {$fa
c4a0: 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 iled} {...set x
c4b0: 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 77 {client socket w
c4c0: 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 as inherited}..
c4d0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 } else {...se
c4e0: 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b t x {client sock
c4f0: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
c500: 69 74 65 64 7d 0a 09 20 20 20 20 7d 0a 09 20 20 ited}.. }..
c510: 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 catch { close
c520: 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 20 $file }..} else
c530: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 69 6d {.. set x {im
c540: 70 6f 73 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 possible case}..
c550: 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 catch { clos
c560: 65 20 24 66 69 6c 65 20 7d 0a 09 7d 0a 09 72 65 e $file }..}..re
c570: 74 75 72 6e 0a 20 20 20 20 7d 0a 0a 20 20 20 20 turn. }..
c580: 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 20 # If the socket
c590: 64 6f 65 73 6e 27 74 20 68 69 74 20 65 6e 64 2d doesn't hit end-
c5a0: 6f 66 2d 66 69 6c 65 20 69 6e 20 35 20 73 65 63 of-file in 5 sec
c5b0: 6f 6e 64 73 2c 20 74 68 65 0a 20 20 20 20 23 20 onds, the. #
c5c0: 73 63 72 69 70 74 31 20 70 72 6f 63 65 73 73 20 script1 process
c5d0: 6d 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 must have inheri
c5e0: 74 65 64 20 74 68 65 20 63 6c 69 65 6e 74 2e 0a ted the client..
c5f0: 0a 20 20 20 20 73 65 74 20 66 61 69 6c 65 64 20 . set failed
c600: 30 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 0. after 5000
c610: 20 5b 6c 69 73 74 20 73 65 74 20 66 61 69 6c 65 [list set faile
c620: 64 20 31 5d 0a 0a 20 20 20 20 23 20 4c 61 75 6e d 1].. # Laun
c630: 63 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 ch the script2 p
c640: 72 6f 63 65 73 73 0a 0a 20 20 20 20 65 78 65 63 rocess.. exec
c650: 20 5b 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 [info nameofexe
c660: 63 75 74 61 62 6c 65 5d 20 73 63 72 69 70 74 32 cutable] script2
c670: 20 26 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a &.. vwait x.
c680: 20 20 20 20 69 66 20 7b 21 24 66 61 69 6c 65 64 if {!$failed
c690: 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 69 6c 65 } {..vwait faile
c6a0: 64 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 6d 6f d. }. remo
c6b0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 veFile script1.
c6c0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
c6d0: 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a ript2. set x.
c6e0: 7d 20 7b 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 } {client socket
c6f0: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
c700: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
c710: 31 32 2e 33 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.3 {testing in
c720: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 61 63 63 heritance of acc
c730: 65 70 74 65 64 20 73 6f 63 6b 65 74 73 7d 20 5c epted sockets} \
c740: 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 ..{socket doTest
c750: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
c760: 72 7d 20 7b 0a 20 20 20 20 23 20 68 61 6e 67 73 r} {. # hangs
c770: 20 6f 6e 20 4c 69 6e 75 78 0a 20 20 20 20 72 65 on Linux. re
c780: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 moveFile script1
c790: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
c7a0: 73 63 72 69 70 74 32 0a 0a 20 20 20 20 73 65 74 script2.. set
c7b0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 f [open script1
c7c0: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
c7d0: 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 {..after 10000 e
c7e0: 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 xit..vwait forev
c7f0: 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f er. }. clo
c800: 73 65 20 24 66 0a 0a 20 20 20 20 73 65 74 20 66 se $f.. set f
c810: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 [open script2 w
c820: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
c830: 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 5b 69 ist set tclsh [i
c840: 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 nfo nameofexecut
c850: 61 62 6c 65 5d 5d 0a 20 20 20 20 70 75 74 73 20 able]]. puts
c860: 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 $f {. .packag
c870: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 e require tls.
c880: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
c890: 22 63 61 74 63 68 20 7b 73 65 74 20 66 20 5c 5b "catch {set f \[
c8a0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
c8b0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
c8c0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
c8d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
c8e0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
c8f0: 72 4b 65 79 20 32 39 33 30 20 5c 5d 7d 22 0a 20 rKey 2930 \]}".
c900: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
c910: 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 oc accept { file
c920: 20 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 host port } {..
c930: 20 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 73 68 global tclsh
c940: 0a 09 20 20 20 20 70 75 74 73 20 24 66 69 6c 65 .. puts $file
c950: 20 7b 74 65 73 74 20 64 61 74 61 20 6f 6e 20 73 {test data on s
c960: 6f 63 6b 65 74 7d 0a 09 20 20 20 20 65 78 65 63 ocket}.. exec
c970: 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 $tclsh script1
c980: 26 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 &.. after 100
c990: 30 20 65 78 69 74 0a 09 7d 0a 09 63 61 74 63 68 0 exit..}..catch
c9a0: 20 7b 76 77 61 69 74 20 66 6f 72 65 76 65 72 7d {vwait forever}
c9b0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
c9c0: 20 24 66 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 $f.. # Launc
c9d0: 68 20 74 68 65 20 73 63 72 69 70 74 32 20 70 72 h the script2 pr
c9e0: 6f 63 65 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 ocess and connec
c9f0: 74 20 74 6f 20 69 74 2e 20 20 53 65 65 20 68 6f t to it. See ho
ca00: 77 20 6c 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 w long. # the
ca10: 20 73 6f 63 6b 65 74 20 73 74 61 79 73 20 6f 70 socket stays op
ca20: 65 6e 0a 0a 20 20 20 20 65 78 65 63 20 5b 69 6e en.. exec [in
ca30: 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 fo nameofexecuta
ca40: 62 6c 65 5d 20 73 63 72 69 70 74 32 20 26 0a 0a ble] script2 &..
ca50: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 73 after 1000 s
ca60: 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 et ok_to_proceed
ca70: 20 31 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 1. vwait ok_
ca80: 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 to_proceed..
ca90: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
caa0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
cab0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
cac0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
cad0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
cae0: 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 Key \.. 127.0
caf0: 2e 30 2e 31 20 32 39 33 30 5d 0a 20 20 20 20 66 .0.1 2930]. f
cb00: 63 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 62 75 configure $f -bu
cb10: 66 66 65 72 69 6e 67 20 66 75 6c 6c 20 2d 62 6c ffering full -bl
cb20: 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 66 69 6c ocking 0. fil
cb30: 65 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 62 eevent $f readab
cb40: 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 61 le [list getdata
cb50: 20 24 66 5d 0a 0a 20 20 20 20 23 20 49 66 20 74 $f].. # If t
cb60: 68 65 20 73 6f 63 6b 65 74 20 69 73 20 73 74 69 he socket is sti
cb70: 6c 6c 20 6f 70 65 6e 20 61 66 74 65 72 20 35 20 ll open after 5
cb80: 73 65 63 6f 6e 64 73 2c 20 74 68 65 20 73 63 72 seconds, the scr
cb90: 69 70 74 31 20 70 72 6f 63 65 73 73 0a 20 20 20 ipt1 process.
cba0: 20 23 20 6d 75 73 74 20 68 61 76 65 20 69 6e 68 # must have inh
cbb0: 65 72 69 74 65 64 20 74 68 65 20 61 63 63 65 70 erited the accep
cbc0: 74 65 64 20 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 ted socket...
cbd0: 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 set failed 0.
cbe0: 20 20 61 66 74 65 72 20 35 30 30 30 20 73 65 74 after 5000 set
cbf0: 20 66 61 69 6c 65 64 20 31 0a 0a 20 20 20 20 70 failed 1.. p
cc00: 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 roc getdata { fi
cc10: 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 le } {...# Read
cc20: 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 63 handler on the c
cc30: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 2e 0a 09 67 lient socket...g
cc40: 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 lobal x..global
cc50: 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 61 74 failed..set stat
cc60: 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 us [catch {read
cc70: 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 69 66 $file} data]..if
cc80: 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d 20 {$status != 0}
cc90: 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b 72 65 {.. set x {re
cca0: 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 ad failed, error
ccb0: 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 20 20 was $data}..
ccc0: 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 catch { close $
ccd0: 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 69 66 file }..} elseif
cce0: 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 {[string compar
ccf0: 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b 0a 09 e {} $data]} {..
cd00: 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 } elseif {[fbloc
cd10: 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d ked $file]} {..}
cd20: 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 66 elseif {[eof $f
cd30: 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 66 20 ile]} {.. if
cd40: 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 73 65 {$failed} {...se
cd50: 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 73 6f t x {accepted so
cd60: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
cd70: 65 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ed}.. } else
cd80: 7b 0a 09 09 73 65 74 20 78 20 7b 61 63 63 65 70 {...set x {accep
cd90: 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ted socket was n
cda0: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 ot inherited}..
cdb0: 20 20 20 7d 0a 09 20 20 20 20 63 61 74 63 68 20 }.. catch
cdc0: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
cdd0: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 .} else {.. s
cde0: 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 et x {impossible
cdf0: 20 63 61 73 65 7d 0a 09 20 20 20 20 63 61 74 63 case}.. catc
ce00: 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 h { close $file
ce10: 7d 0a 09 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 }..}..return.
ce20: 20 7d 0a 20 20 20 20 0a 20 20 20 20 76 77 61 69 }. . vwai
ce30: 74 20 78 0a 0a 20 20 20 20 72 65 6d 6f 76 65 46 t x.. removeF
ce40: 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 ile script1.
ce50: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
ce60: 74 32 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b t2. set x.} {
ce70: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 accepted socket
ce80: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
ce90: 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 d}..test tlsIO-1
cea0: 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 75 73 65 3.1 {Testing use
ceb0: 20 6f 66 20 73 68 61 72 65 64 20 73 6f 63 6b 65 of shared socke
cec0: 74 20 62 65 74 77 65 65 6e 20 74 77 6f 20 74 68 t between two th
ced0: 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 reads} \..{socke
cee0: 74 20 74 65 73 74 74 68 72 65 61 64 7d 20 7b 0a t testthread} {.
cef0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
cf00: 73 63 72 69 70 74 0a 20 20 20 20 74 68 72 65 61 script. threa
cf10: 64 52 65 61 70 0a 0a 20 20 20 20 6d 61 6b 65 46 dReap.. makeF
cf20: 69 6c 65 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 ile {. .packa
cf30: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
cf40: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
cf50: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
cf60: 74 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 t 2828]..proc ac
cf70: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 cept {s a p} {.
cf80: 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 filee
cf90: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
cfa0: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
cfb0: 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f 6e fcon
cfc0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
cfd0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 20 ring line.
cfe0: 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b }..proc echo {
cff0: 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 s} {.. globa
d000: 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 l i.
d010: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
d020: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 . if
d030: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 {[eof $s]} {.
d040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 g
d050: 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 lobal x.
d060: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
d070: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
d080: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 set x done.
d090: 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 } els
d0a0: 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 20 69 e { .. i
d0b0: 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 ncr i.
d0c0: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 puts $s $
d0d0: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d l. }
d0e0: 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 76 77 ..}..set i 0..vw
d0f0: 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 24 66 0a ait x..close $f.
d100: 0a 09 23 20 74 68 72 65 61 64 20 63 6c 65 61 6e ..# thread clean
d110: 73 20 69 74 73 65 6c 66 20 75 70 2e 0a 09 74 65 s itself up...te
d120: 73 74 74 68 72 65 61 64 20 65 78 69 74 0a 20 20 stthread exit.
d130: 20 20 7d 20 73 63 72 69 70 74 0a 20 20 20 20 0a } script. .
d140: 20 20 20 20 23 20 63 72 65 61 74 65 20 61 20 74 # create a t
d150: 68 72 65 61 64 0a 20 20 20 20 73 65 74 20 73 65 hread. set se
d160: 72 76 65 72 74 68 72 65 61 64 20 5b 74 65 73 74 rverthread [test
d170: 74 68 72 65 61 64 20 63 72 65 61 74 65 20 7b 20 thread create {
d180: 73 6f 75 72 63 65 20 73 63 72 69 70 74 20 7d 20 source script }
d190: 5d 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 20 ]. update.
d1a0: 20 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 . after 1000
d1b0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
d1c0: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
d1d0: 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 2828]. fcon
d1e0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
d1f0: 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 ring line.. c
d200: 61 74 63 68 20 7b 0a 09 70 75 74 73 20 24 73 20 atch {..puts $s
d210: 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 "hello"..gets $s
d220: 20 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 result. }.
d230: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 close $s. u
d240: 70 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 72 pdate.. after
d250: 20 32 30 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 2000. lappen
d260: 64 20 72 65 73 75 6c 74 20 5b 74 68 72 65 61 64 d result [thread
d270: 52 65 61 70 5d 0a 20 20 20 20 0a 20 20 20 20 73 Reap]. . s
d280: 65 74 20 72 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 et result..} {he
d290: 6c 6c 6f 20 31 7d 0a 0a 23 20 63 6c 65 61 6e 75 llo 1}..# cleanu
d2a0: 70 0a 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 p.if {[string ma
d2b0: 74 63 68 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 tch sock* $comma
d2c0: 6e 64 53 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 ndSocket] == 1}
d2d0: 7b 0a 20 20 20 70 75 74 73 20 24 63 6f 6d 6d 61 {. puts $comma
d2e0: 6e 64 53 6f 63 6b 65 74 20 65 78 69 74 0a 20 20 ndSocket exit.
d2f0: 20 66 6c 75 73 68 20 24 63 6f 6d 6d 61 6e 64 53 flush $commandS
d300: 6f 63 6b 65 74 0a 7d 0a 63 61 74 63 68 20 7b 63 ocket.}.catch {c
d310: 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 lose $commandSoc
d320: 6b 65 74 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 ket}.catch {clos
d330: 65 20 24 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 e $remoteProcCha
d340: 6e 7d 0a 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 6c n}.::tcltest::cl
d350: 65 61 6e 75 70 54 65 73 74 73 0a 66 6c 75 73 68 eanupTests.flush
d360: 20 73 74 64 6f 75 74 0a 72 65 74 75 72 6e 0a 0a stdout.return..