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 34 20 32 30 30 30 2f 30 36 2f 30 35 20 32 32 .4 2000/06/05 22
0210: 3a 33 33 3a 32 36 20 61 62 6f 72 72 20 45 78 70 :33:26 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 73 65 72 76 65 72 43 65 72 74 20 .set serverCert
0bb0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 63 [file join $::tc
0bc0: 6c 74 65 73 74 3a 3a 74 65 73 74 73 44 69 72 65 ltest::testsDire
0bd0: 63 74 6f 72 79 20 63 65 72 74 73 20 73 65 72 76 ctory certs serv
0be0: 65 72 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 er.pem].set clie
0bf0: 6e 74 43 65 72 74 20 5b 66 69 6c 65 20 6a 6f 69 ntCert [file joi
0c00: 6e 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 n $::tcltest::te
0c10: 73 74 73 44 69 72 65 63 74 6f 72 79 20 63 65 72 stsDirectory cer
0c20: 74 73 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 73 ts client.pem].s
0c30: 65 74 20 63 61 43 65 72 74 20 5b 66 69 6c 65 20 et caCert [file
0c40: 6a 6f 69 6e 20 24 3a 3a 74 63 6c 74 65 73 74 3a join $::tcltest:
0c50: 3a 74 65 73 74 73 44 69 72 65 63 74 6f 72 79 20 :testsDirectory
0c60: 63 65 72 74 73 20 63 61 63 65 72 74 2e 70 65 6d certs cacert.pem
0c70: 5d 0a 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 ].set serverKey
0c80: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a 3a 74 63 [file join $::tc
0c90: 6c 74 65 73 74 3a 3a 74 65 73 74 73 44 69 72 65 ltest::testsDire
0ca0: 63 74 6f 72 79 20 63 65 72 74 73 20 73 6b 65 79 ctory certs skey
0cb0: 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 65 6e 74 .pem].set client
0cc0: 4b 65 79 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 Key [file join $
0cd0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 74 73 ::tcltest::tests
0ce0: 44 69 72 65 63 74 6f 72 79 20 63 65 72 74 73 20 Directory certs
0cf0: 63 6b 65 79 2e 70 65 6d 5d 0a 0a 23 20 53 6f 6d ckey.pem]..# Som
0d00: 65 20 74 65 73 74 73 20 72 65 71 75 69 72 65 20 e tests require
0d10: 74 68 65 20 74 65 73 74 74 68 72 65 61 64 20 63 the testthread c
0d20: 6f 6d 6d 61 6e 64 0a 0a 73 65 74 20 3a 3a 74 63 ommand..set ::tc
0d30: 6c 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 ltest::testConst
0d40: 72 61 69 6e 74 73 28 74 65 73 74 74 68 72 65 61 raints(testthrea
0d50: 64 29 20 5c 0a 09 5b 65 78 70 72 20 7b 5b 69 6e d) \..[expr {[in
0d60: 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 74 65 73 74 fo commands test
0d70: 74 68 72 65 61 64 5d 20 21 3d 20 7b 7d 7d 5d 0a thread] != {}}].
0d80: 0a 23 0a 23 20 49 66 20 72 65 6d 6f 74 65 53 65 .#.# If remoteSe
0d90: 72 76 65 72 49 50 20 6f 72 20 72 65 6d 6f 74 65 rverIP or remote
0da0: 53 65 72 76 65 72 50 6f 72 74 20 61 72 65 20 6e ServerPort are n
0db0: 6f 74 20 73 65 74 2c 20 63 68 65 63 6b 20 69 6e ot set, check in
0dc0: 20 74 68 65 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 the.# environme
0dd0: 6e 74 20 76 61 72 69 61 62 6c 65 73 20 66 6f 72 nt variables for
0de0: 20 65 78 74 65 72 6e 61 6c 6c 79 20 73 65 74 20 externally set
0df0: 76 61 6c 75 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 values..#..if {!
0e00: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
0e10: 6f 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a oteServerIP]} {.
0e20: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
0e30: 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 ists env(remoteS
0e40: 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 erverIP)]} {..se
0e50: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 t remoteServerIP
0e60: 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 $env(remoteServ
0e70: 65 72 49 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 erIP). }.}.if
0e80: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
0e90: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
0ea0: 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e ]} {. if {[in
0eb0: 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 65 fo exists env(re
0ec0: 6d 6f 74 65 53 65 72 76 65 72 49 50 29 5d 7d 20 moteServerIP)]}
0ed0: 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 65 72 {..set remoteSer
0ee0: 76 65 72 50 6f 72 74 20 24 65 6e 76 28 72 65 6d verPort $env(rem
0ef0: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 0a 20 oteServerPort).
0f00: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
0f10: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
0f20: 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 ists remoteServe
0f30: 72 49 50 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 rIP]} {.. set
0f40: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 remoteServerPor
0f50: 74 20 32 30 34 38 0a 20 20 20 20 20 20 20 20 7d t 2048. }
0f60: 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 68 . }.}..#.# Ch
0f70: 65 63 6b 20 69 66 20 77 65 27 72 65 20 73 75 70 eck if we're sup
0f80: 70 6f 73 65 64 20 74 6f 20 64 6f 20 74 65 73 74 posed to do test
0f90: 73 20 61 67 61 69 6e 73 74 20 74 68 65 20 72 65 s against the re
0fa0: 6d 6f 74 65 20 73 65 72 76 65 72 0a 23 0a 0a 73 mote server.#..s
0fb0: 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 et doTestsWithRe
0fc0: 6d 6f 74 65 53 65 72 76 65 72 20 31 0a 69 66 20 moteServer 1.if
0fd0: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 {![info exists r
0fe0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 20 26 emoteServerIP] &
0ff0: 26 20 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d & ($tcl_platform
1000: 28 70 6c 61 74 66 6f 72 6d 29 20 21 3d 20 22 6d (platform) != "m
1010: 61 63 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 20 acintosh")} {.
1020: 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 set remoteServ
1030: 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 7d erIP 127.0.0.1.}
1040: 0a 69 66 20 7b 28 24 64 6f 54 65 73 74 73 57 69 .if {($doTestsWi
1050: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d thRemoteServer =
1060: 3d 20 31 29 20 26 26 20 28 21 5b 69 6e 66 6f 20 = 1) && (![info
1070: 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 exists remoteSer
1080: 76 65 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 20 verPort])} {.
1090: 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 set remoteServe
10a0: 72 50 6f 72 74 20 32 30 34 38 0a 7d 0a 0a 23 20 rPort 2048.}..#
10b0: 41 74 74 65 6d 70 74 20 74 6f 20 63 6f 6e 6e 65 Attempt to conne
10c0: 63 74 20 74 6f 20 61 20 72 65 6d 6f 74 65 20 73 ct to a remote s
10d0: 65 72 76 65 72 20 69 66 20 6f 6e 65 20 69 73 20 erver if one is
10e0: 61 6c 72 65 61 64 79 20 72 75 6e 6e 69 6e 67 2e already running.
10f0: 20 49 66 20 69 74 0a 23 20 69 73 20 6e 6f 74 20 If it.# is not
1100: 72 75 6e 6e 69 6e 67 20 6f 72 20 66 6f 72 20 73 running or for s
1110: 6f 6d 65 20 6f 74 68 65 72 20 72 65 61 73 6f 6e ome other reason
1120: 20 74 68 65 20 63 6f 6e 6e 65 63 74 20 66 61 69 the connect fai
1130: 6c 73 2c 20 61 74 74 65 6d 70 74 20 74 6f 0a 23 ls, attempt to.#
1140: 20 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 start the remot
1150: 65 20 73 65 72 76 65 72 20 6f 6e 20 74 68 65 20 e server on the
1160: 6c 6f 63 61 6c 20 68 6f 73 74 20 6c 69 73 74 65 local host liste
1170: 6e 69 6e 67 20 6f 6e 20 70 6f 72 74 20 32 30 34 ning on port 204
1180: 38 2e 20 54 68 69 73 0a 23 20 69 73 20 6f 6e 6c 8. This.# is onl
1190: 79 20 64 6f 6e 65 20 6f 6e 20 70 6c 61 74 66 6f y done on platfo
11a0: 72 6d 73 20 74 68 61 74 20 73 75 70 70 6f 72 74 rms that support
11b0: 20 65 78 65 63 20 28 69 2e 65 2e 20 6e 6f 74 20 exec (i.e. not
11c0: 6f 6e 20 74 68 65 20 4d 61 63 29 2e 20 4f 6e 0a on the Mac). On.
11d0: 23 20 70 6c 61 74 66 6f 72 6d 73 20 74 68 61 74 # platforms that
11e0: 20 64 6f 20 6e 6f 74 20 73 75 70 70 6f 72 74 20 do not support
11f0: 65 78 65 63 2c 20 74 68 65 20 72 65 6d 6f 74 65 exec, the remote
1200: 20 73 65 72 76 65 72 20 6d 75 73 74 20 62 65 20 server must be
1210: 73 74 61 72 74 65 64 0a 23 20 62 79 20 74 68 65 started.# by the
1220: 20 75 73 65 72 20 62 65 66 6f 72 65 20 72 75 6e user before run
1230: 6e 69 6e 67 20 74 68 65 20 74 65 73 74 73 2e 0a ning the tests..
1240: 0a 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 .set remoteProcC
1250: 68 61 6e 20 22 22 0a 73 65 74 20 63 6f 6d 6d 61 han "".set comma
1260: 6e 64 53 6f 63 6b 65 74 20 22 22 0a 69 66 20 7b ndSocket "".if {
1270: 24 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f $doTestsWithRemo
1280: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
1290: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 6f catch {close $co
12a0: 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 20 20 20 mmandSocket}.
12b0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 if {[catch {set
12c0: 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b commandSocket [
12d0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
12e0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
12f0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
1300: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
1310: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
1320: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
1330: 72 49 50 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f rIP \.. $remo
1340: 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 5d 20 teServerPort]}]
1350: 21 3d 20 30 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e != 0} {..if {[in
1360: 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 fo commands exec
1370: 5d 20 3d 3d 20 22 22 7d 20 7b 0a 09 20 20 20 20 ] == ""} {..
1380: 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 set noRemoteTest
1390: 52 65 61 73 6f 6e 20 22 63 61 6e 27 74 20 65 78 Reason "can't ex
13a0: 65 63 22 0a 09 20 20 20 20 73 65 74 20 64 6f 54 ec".. set doT
13b0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
13c0: 72 76 65 72 20 30 0a 09 7d 20 65 6c 73 65 20 7b rver 0..} else {
13d0: 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 .. set remote
13e0: 53 65 72 76 65 72 49 50 20 31 32 37 2e 30 2e 30 ServerIP 127.0.0
13f0: 2e 31 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f .1.. set remo
1400: 74 65 46 69 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 teFile [file joi
1410: 6e 20 5b 70 77 64 5d 20 72 65 6d 6f 74 65 2e 74 n [pwd] remote.t
1420: 63 6c 5d 0a 09 20 20 20 20 69 66 20 7b 5b 63 61 cl].. if {[ca
1430: 74 63 68 20 7b 73 65 74 20 72 65 6d 6f 74 65 50 tch {set remoteP
1440: 72 6f 63 43 68 61 6e 20 5c 0a 09 09 09 09 5b 6f rocChan \.....[o
1450: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
1460: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
1470: 24 72 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 09 $remoteFile \...
1480: 09 09 09 2d 73 65 72 76 65 72 49 73 53 69 6c 65 ...-serverIsSile
1490: 6e 74 20 5c 0a 09 09 09 09 09 2d 70 6f 72 74 20 nt \......-port
14a0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 $remoteServerPor
14b0: 74 20 5c 0a 09 09 09 09 09 2d 61 64 64 72 65 73 t \......-addres
14c0: 73 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 s $remoteServerI
14d0: 50 5d 22 20 5c 0a 09 09 09 09 09 77 2b 5d 7d 20 P]" \......w+]}
14e0: 5c 0a 09 09 20 20 20 6d 73 67 5d 20 3d 3d 20 30 \... msg] == 0
14f0: 7d 20 7b 0a 09 09 61 66 74 65 72 20 31 30 30 30 } {...after 1000
1500: 0a 09 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 ...if {[catch {s
1510: 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 et commandSocket
1520: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
1530: 09 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
1540: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
1550: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
1560: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
1570: 5c 0a 09 09 09 09 24 72 65 6d 6f 74 65 53 65 72 \.....$remoteSer
1580: 76 65 72 49 50 20 5c 0a 09 09 09 09 24 72 65 6d verIP \.....$rem
1590: 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d 20 oteServerPort]}
15a0: 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 msg] == 0} {...
15b0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 fconfigure $c
15c0: 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 72 ommandSocket -tr
15d0: 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d anslation crlf -
15e0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
15f0: 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 .} else {...
1600: 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 set noRemoteTest
1610: 52 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 20 Reason $msg...
1620: 20 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 set doTestsWit
1630: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a hRemoteServer 0.
1640: 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ..}.. } else
1650: 7b 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 65 {...set noRemote
1660: 54 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 67 TestReason "$msg
1670: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
1680: 74 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54 65 test"...set doTe
1690: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
16a0: 76 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d 0a ver 0.. }..}.
16b0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 63 } else {..fc
16c0: 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e onfigure $comman
16d0: 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 dSocket -transla
16e0: 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 tion crlf -buffe
16f0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d 0a ring line. }.
1700: 7d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 }..# Some tests
1710: 61 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 20 are run only if
1720: 77 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65 73 we are doing tes
1730: 74 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20 72 ting against a r
1740: 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 65 emote server..se
1750: 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 73 t ::tcltest::tes
1760: 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f 54 tConstraints(doT
1770: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1780: 72 76 65 72 29 20 24 64 6f 54 65 73 74 73 57 69 rver) $doTestsWi
1790: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a 69 thRemoteServer.i
17a0: 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 f {$doTestsWithR
17b0: 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 30 emoteServer == 0
17c0: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 } {. if {[str
17d0: 69 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a 74 ing first s $::t
17e0: 63 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 5d cltest::verbose]
17f0: 20 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 70 != -1} {. .p
1800: 75 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74 65 uts "Skipping te
1810: 73 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65 20 sts with remote
1820: 73 65 72 76 65 72 2e 20 53 65 65 20 74 65 73 74 server. See test
1830: 73 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 6f s/socket.test fo
1840: 72 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 6d r"..puts "inform
1850: 61 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f 20 ation on how to
1860: 72 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 65 run remote serve
1870: 72 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73 6f r."..puts "Reaso
1880: 6e 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 20 n for not doing
1890: 72 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 6e remote tests: $n
18a0: 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f oRemoteTestReaso
18b0: 6e 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 n". }.}..#.#
18c0: 49 66 20 77 65 20 64 6f 20 74 68 65 20 74 65 73 If we do the tes
18d0: 74 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f 6d ts, define a com
18e0: 6d 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 63 mand to send a c
18f0: 6f 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 20 ommand to the.#
1900: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 23 remote server..#
1910: 0a 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 ..if {$doTestsWi
1920: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d thRemoteServer =
1930: 3d 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 = 1} {. proc
1940: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d 20 sendCommand {c}
1950: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 6e {..global comman
1960: 64 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b 65 dSocket...if {[e
1970: 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 of $commandSocke
1980: 74 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 t]} {.. error
1990: 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 "remote server
19a0: 64 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d 0a disappeared"..}.
19b0: 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 ..if {[catch {pu
19c0: 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 ts $commandSocke
19d0: 74 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 t $c} msg]} {..
19e0: 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 error "remote
19f0: 20 73 65 72 76 65 72 20 64 69 73 61 70 70 61 65 server disappae
1a00: 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 69 red: $msg"..}..i
1a10: 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 20 f {[catch {puts
1a20: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 $commandSocket "
1a30: 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 --Marker--Marker
1a40: 2d 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 67 --Marker--"} msg
1a50: 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 20 ]} {.. error
1a60: 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 "remote server d
1a70: 69 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 67 isappeared: $msg
1a80: 22 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 20 "..}...set resp
1a90: 22 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b 0a ""..while {1} {.
1aa0: 09 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b 67 . set line [g
1ab0: 65 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ets $commandSock
1ac0: 65 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f et].. if {[eo
1ad0: 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 f $commandSocket
1ae0: 5d 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 65 ]} {...error "re
1af0: 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 61 mote server disa
1b00: 70 70 65 61 72 65 64 22 0a 09 20 20 20 20 7d 0a ppeared".. }.
1b10: 09 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 . if {[string
1b20: 20 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 22 compare $line "
1b30: 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 --Marker--Marker
1b40: 2d 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d 20 --Marker--"] ==
1b50: 30 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 69 0} {...if {[stri
1b60: 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 ng compare [lind
1b70: 65 78 20 24 72 65 73 70 20 30 5d 20 65 72 72 6f ex $resp 0] erro
1b80: 72 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 20 r] == 0} {...
1b90: 20 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 24 error [lindex $
1ba0: 72 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 65 resp 1]...} else
1bb0: 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e 20 {... return
1bc0: 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 5d [lindex $resp 1]
1bd0: 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 ...}.. } else
1be0: 20 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 70 {...append resp
1bf0: 20 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 20 $line "\n"..
1c00: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 74 }..}. }.}..t
1c10: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 7b 61 est tlsIO-1.1 {a
1c20: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
1c30: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
1c40: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
1c50: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
1c60: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d 20 socket -server}
1c70: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
1c80: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
1c90: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
1ca0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d cket -server com
1cb0: 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 mand ?options? p
1cc0: 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 ort"}}..test tls
1cd0: 49 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 73 IO-1.2 {arg pars
1ce0: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
1cf0: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
1d00: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
1d10: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
1d20: 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 67 -server foo} msg
1d30: 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f ] $msg.} {1 {wro
1d40: 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c ng # args: shoul
1d50: 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 d be "tls::socke
1d60: 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e t -server comman
1d70: 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 d ?options? port
1d80: 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d "}}..test tlsIO-
1d90: 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.3 {arg parsing
1da0: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
1db0: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
1dc0: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
1dd0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
1de0: 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a addr} msg] $msg.
1df0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
1e00: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
1e10: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
1e20: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
1e30: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
1e40: 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 4 {arg parsing f
1e50: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
1e60: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
1e70: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
1e80: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 ls::socket -myad
1e90: 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 6d 73 dr 127.0.0.1} ms
1ea0: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
1eb0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
1ec0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
1ed0: 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 et ?options? hos
1ee0: 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 t port"}}..test
1ef0: 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 20 70 tlsIO-1.5 {arg p
1f00: 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 arsing for socke
1f10: 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b t command} {sock
1f20: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
1f30: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
1f40: 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 67 5d et -myport} msg]
1f50: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
1f60: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
1f70: 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 be "tls::socket
1f80: 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 ?options? host
1f90: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
1fa0: 73 49 4f 2d 31 2e 36 20 7b 61 72 67 20 70 61 72 sIO-1.6 {arg par
1fb0: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
1fc0: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
1fd0: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
1fe0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
1ff0: 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 7d 20 6d -myport xxxx} m
2000: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
2010: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
2020: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 uld be "tls::soc
2030: 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 6f ket ?options? ho
2040: 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 st port"}}..test
2050: 20 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 72 67 20 tlsIO-1.7 {arg
2060: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
2070: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
2080: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
2090: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
20a0: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32 35 32 32 ket -myport 2522
20b0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
20c0: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
20d0: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
20e0: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
20f0: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2100: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 38 20 7b 61 est tlsIO-1.8 {a
2110: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2120: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2130: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2140: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2150: 73 6f 63 6b 65 74 20 2d 66 72 6f 62 6f 7a 7d 20 socket -froboz}
2160: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
2170: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
2180: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
2190: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
21a0: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
21b0: 74 20 74 6c 73 49 4f 2d 31 2e 39 20 7b 61 72 67 t tlsIO-1.9 {arg
21c0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
21d0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
21e0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
21f0: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2200: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f cket -server foo
2210: 20 2d 6d 79 70 6f 72 74 20 32 35 32 31 20 33 33 -myport 2521 33
2220: 33 33 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 33} msg] $msg.}
2230: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
2240: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
2250: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2260: 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e command ?option
2270: 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 s? port"}}..test
2280: 20 74 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67 tlsIO-1.10 {arg
2290: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
22a0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
22b0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
22c0: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
22d0: 63 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d cket host 2528 -
22e0: 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a junk} msg] $msg.
22f0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2300: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2310: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
2320: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
2330: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2340: 31 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 11 {arg parsing
2350: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
2360: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
2370: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
2380: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
2390: 76 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 ver callback 252
23a0: 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 0 --} msg] $msg.
23b0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
23c0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
23d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
23e0: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 er command ?opti
23f0: 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 ons? port"}}..te
2400: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 st tlsIO-1.12 {a
2410: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2420: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2430: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2440: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2450: 73 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f socket foo badpo
2460: 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 rt} msg] $msg.}
2470: 7b 31 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74 {1 {expected int
2480: 65 67 65 72 20 62 75 74 20 67 6f 74 20 22 62 61 eger but got "ba
2490: 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 dport"}}..test t
24a0: 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f lsIO-2.1 {tcp co
24b0: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
24c0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
24d0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
24e0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
24f0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
2500: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
2510: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
2520: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
2530: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
2540: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
2550: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
2560: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
2570: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
2580: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
2590: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
25a0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
25b0: 20 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 38 $serverKey 2828
25c0: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
25d0: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
25e0: 7b 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 7d {file addr port}
25f0: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 {.. global x
2600: 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 .. set x done
2610: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
2620: 73 65 20 24 66 69 6c 65 0a 09 7d 0a 09 70 75 74 se $file..}..put
2630: 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 s ready..vwait x
2640: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
2650: 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a timer..close $f.
2660: 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 .puts $x. }.
2670: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
2680: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
2690: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
26a0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
26b0: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 r]. gets $f
26c0: 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 x. if {[catch
26d0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 {tls::socket -c
26e0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
26f0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
2700: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
2710: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
2720: 2e 30 2e 31 20 32 38 32 38 7d 20 6d 73 67 5d 7d .0.1 2828} msg]}
2730: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 {. set x
2740: 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 $msg. } else
2750: 20 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 {. lappe
2760: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
2770: 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 close $ms
2780: 67 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 g. }. lapp
2790: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
27a0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
27b0: 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 set x.} {ready
27c0: 64 6f 6e 65 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e done {}}..if [in
27d0: 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 20 fo exists port]
27e0: 7b 0a 20 20 20 20 69 6e 63 72 20 70 6f 72 74 0a {. incr port.
27f0: 7d 20 65 6c 73 65 20 7b 20 0a 20 20 20 20 73 65 } else { . se
2800: 74 20 70 6f 72 74 20 5b 65 78 70 72 20 32 30 34 t port [expr 204
2810: 38 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 8 + [pid]%1024].
2820: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
2830: 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 2 {tcp connectio
2840: 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 20 70 6f n with client po
2850: 72 74 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 rt specified} {s
2860: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
2870: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
2880: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
2890: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
28a0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
28b0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
28c0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
28d0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
28e0: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
28f0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
2900: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
2910: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
2920: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
2930: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
2940: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
2950: 76 65 72 4b 65 79 20 32 38 32 39 20 5c 5d 22 0a verKey 2829 \]".
2960: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
2970: 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c 65 roc accept {file
2980: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
2990: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
29a0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
29b0: 75 74 73 20 22 5b 67 65 74 73 20 24 66 69 6c 65 uts "[gets $file
29c0: 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 20 20 20 ] $port".
29d0: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 close $file
29e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
29f0: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
2a00: 20 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a ready..vwait x.
2a10: 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 .after cancel $t
2a20: 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 imer..close $f.
2a30: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
2a40: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
2a50: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
2a60: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
2a70: 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 ript]" r]. ge
2a80: 74 73 20 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 ts $f x. glob
2a90: 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 20 7b al port. if {
2aa0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2ab0: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 ket -myport $por
2ac0: 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 t \..-certfile $
2ad0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
2ae0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
2af0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
2b00: 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 y 127.0.0.1 2829
2b10: 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 } sock]} {.
2b20: 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 09 set x $sock..
2b30: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b 74 6c catch {close [tl
2b40: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
2b50: 30 2e 31 20 32 38 32 39 5d 7d 0a 20 20 20 20 7d 0.1 2829]}. }
2b60: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
2b70: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
2b80: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 ..flush $sock.
2b90: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
2ba0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
2bb0: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
2bc0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
2bd0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 5b 6c 69 . set x.} [li
2be0: 73 74 20 72 65 61 64 79 20 22 68 65 6c 6c 6f 20 st ready "hello
2bf0: 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 74 6c $port"]..test tl
2c00: 73 49 4f 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e sIO-2.3 {tcp con
2c10: 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 nection with cli
2c20: 65 6e 74 20 69 6e 74 65 72 66 61 63 65 20 73 70 ent interface sp
2c30: 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 ecified} {socket
2c40: 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 stdio} {. re
2c50: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
2c60: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
2c70: 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 script w]. pu
2c80: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
2c90: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
2ca0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
2cb0: 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 000 "set x done"
2cc0: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 ]. }. puts
2cd0: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
2ce0: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
2cf0: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
2d00: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
2d10: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
2d20: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
2d30: 79 20 32 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 y 2830 \]". p
2d40: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
2d50: 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 ccept {file addr
2d60: 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 port} {.
2d70: 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 global x.
2d80: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 puts "
2d90: 5b 67 65 74 73 20 24 66 69 6c 65 5d 20 24 61 64 [gets $file] $ad
2da0: 64 72 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 dr".
2db0: 63 6c 6f 73 65 20 24 66 69 6c 65 0a 20 20 20 20 close $file.
2dc0: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
2dd0: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
2de0: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
2df0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
2e00: 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a .close $f. }.
2e10: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
2e20: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
2e30: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
2e40: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
2e50: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
2e60: 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 x. if {[catc
2e70: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2e80: 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 myaddr 127.0.0.1
2e90: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
2ea0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
2eb0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
2ec0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
2ed0: 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 33 30 7d 127.0.0.1 2830}
2ee0: 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 sock]} {.
2ef0: 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 set x $sock.
2f00: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
2f10: 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 puts $sock he
2f20: 6c 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 llo..catch {flus
2f30: 68 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 h $sock}.
2f40: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
2f50: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
2f60: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
2f70: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
2f80: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b set x.} {ready {
2f90: 68 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d hello 127.0.0.1}
2fa0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e }..test tlsIO-2.
2fb0: 34 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 4 {tcp connectio
2fc0: 6e 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e n with server in
2fd0: 74 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 terface specifie
2fe0: 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f d} {socket stdio
2ff0: 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 } {. removeFi
3000: 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 le script. se
3010: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
3020: 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 w]. puts $f
3030: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
3040: 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 re tls..set time
3050: 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 r [after 2000 "s
3060: 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 et x done"].
3070: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
3080: 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et f \[tls::sock
3090: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
30a0: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
30b0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
30c0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
30d0: 20 24 73 65 72 76 65 72 4b 65 79 20 2d 6d 79 61 $serverKey -mya
30e0: 64 64 72 20 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 ddr [info hostna
30f0: 6d 65 5d 20 32 38 33 31 20 5c 5d 22 0a 20 20 20 me] 2831 \]".
3100: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
3110: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 accept {file ad
3120: 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 dr port} {.
3130: 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a global x.
3140: 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 puts
3150: 20 22 5b 67 65 74 73 20 24 66 69 6c 65 5d 22 0a "[gets $file]".
3160: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
3170: 65 20 24 66 69 6c 65 0a 20 20 20 20 20 20 20 20 e $file.
3180: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
3190: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 }..puts ready..v
31a0: 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 wait x..after ca
31b0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f ncel $timer..clo
31c0: 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 se $f. }.
31d0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
31e0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
31f0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
3200: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
3210: 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 . gets $f x.
3220: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 if {[catch {t
3230: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
3240: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3250: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3260: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3270: 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f 20 68 6f ientKey [info ho
3280: 73 74 6e 61 6d 65 5d 20 32 38 33 31 7d 20 73 6f stname] 2831} so
3290: 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 ck]} {. s
32a0: 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d et x $sock. }
32b0: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
32c0: 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f puts $sock hello
32d0: 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 ..flush $sock.
32e0: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
32f0: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
3300: 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 close $sock.
3310: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
3320: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 . set x.} {re
3330: 61 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 ady hello}..test
3340: 20 74 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 70 20 tlsIO-2.5 {tcp
3350: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
3360: 72 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 redundant server
3370: 20 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 port} {socket s
3380: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
3390: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
33a0: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
33b0: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
33c0: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
33d0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
33e0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
33f0: 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 0 "set x done"].
3400: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
3410: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
3420: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
3430: 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 ccept -certfile
3440: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
3450: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
3460: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
3470: 32 38 33 32 20 5c 5d 22 0a 20 20 20 20 70 75 74 2832 \]". put
3480: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
3490: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
34a0: 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 ort} {.
34b0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
34c0: 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b 67 puts "[g
34d0: 65 74 73 20 24 66 69 6c 65 5d 22 0a 20 20 20 20 ets $file]".
34e0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 66 close $f
34f0: 69 6c 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ile.
3500: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
3510: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3520: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3530: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3540: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
3550: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
3560: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
3570: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
3580: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
3590: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 gets $f x. i
35a0: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
35b0: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
35c0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
35d0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
35e0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
35f0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 Key 127.0.0.1 28
3600: 33 32 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 32} sock]} {.
3610: 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 6b set x $sock
3620: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
3630: 20 20 20 20 20 20 70 75 74 73 20 24 73 6f 63 6b puts $sock
3640: 20 68 65 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 hello..flush $s
3650: 6f 63 6b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 ock. lapp
3660: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
3670: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3680: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ock. }. cl
3690: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
36a0: 0a 7d 20 7b 72 65 61 64 79 20 68 65 6c 6c 6f 7d .} {ready hello}
36b0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 36 20 .test tlsIO-2.6
36c0: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d {tcp connection}
36d0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
36e0: 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 set status ok.
36f0: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 if {![catch {s
3700: 65 74 20 73 6f 63 6b 20 5b 74 6c 73 3a 3a 73 6f et sock [tls::so
3710: 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 cket 127.0.0.1 2
3720: 38 33 33 5d 7d 5d 7d 20 7b 0a 09 69 66 20 7b 21 833]}]} {..if {!
3730: 5b 63 61 74 63 68 20 7b 67 65 74 73 20 24 73 6f [catch {gets $so
3740: 63 6b 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 74 ck}]} {.. set
3750: 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a 09 status broken..
3760: 7d 0a 09 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 }..close $sock.
3770: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 }. set sta
3780: 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 tus.} ok..test t
3790: 6c 73 49 4f 2d 32 2e 37 20 7b 65 63 68 6f 20 73 lsIO-2.7 {echo s
37a0: 65 72 76 65 72 2c 20 6f 6e 65 20 6c 69 6e 65 7d erver, one line}
37b0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
37c0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
37d0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
37e0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
37f0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
3800: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
3810: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
3820: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
3830: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
3840: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
3850: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
3860: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
3870: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
3880: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
3890: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
38a0: 73 65 72 76 65 72 4b 65 79 20 32 38 33 34 20 5c serverKey 2834 \
38b0: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
38c0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
38d0: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
38e0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
38f0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
3900: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
3910: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 61 onfigure $s -tra
3920: 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 nslation lf -buf
3930: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
3940: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
3950: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 73 65 74 {s} {.. set
3960: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
3970: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
3980: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
3990: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
39a0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
39b0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
39d0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
39e0: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
39f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a00: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
3a10: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 }..}..p
3a20: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
3a30: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
3a40: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
3a50: 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a 20 20 20 f..puts done.
3a60: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3a70: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3a80: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
3a90: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
3aa0: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
3ab0: 20 24 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 $f. set s [t
3ac0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
3ad0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
3ae0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
3af0: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c \..-keyfile $cl
3b00: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
3b10: 31 20 32 38 33 34 5d 0a 20 20 20 20 66 63 6f 6e 1 2834]. fcon
3b20: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
3b30: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
3b40: 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 70 75 lation lf. pu
3b50: 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 ts $s "hello abc
3b60: 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 20 defghijklmnop".
3b70: 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 after 1000.
3b80: 20 20 73 65 74 20 78 20 5b 67 65 74 73 20 24 73 set x [gets $s
3b90: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
3ba0: 20 20 20 73 65 74 20 79 20 5b 67 65 74 73 20 24 set y [gets $
3bb0: 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a f]. close $f.
3bc0: 20 20 20 20 6c 69 73 74 20 24 78 20 24 79 0a 7d list $x $y.}
3bd0: 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 {{hello abcdefg
3be0: 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f 6e 65 7d hijklmnop} done}
3bf0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 38 ..test tlsIO-2.8
3c00: 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6c {echo server, l
3c10: 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c 20 73 69 oop 50 times, si
3c20: 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d ngle connection}
3c30: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
3c40: 7b 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 {. set f [ope
3c50: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
3c60: 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 puts $f {. .p
3c70: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
3c80: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
3c90: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
3ca0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
3cb0: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
3cc0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
3cd0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
3ce0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
3cf0: 65 79 20 32 38 33 35 20 5c 5d 22 0a 20 20 20 20 ey 2835 \]".
3d00: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
3d10: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
3d20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c . fil
3d30: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
3d40: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
3d50: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 ]. fc
3d60: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
3d70: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
3d80: 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f }..proc echo
3d90: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f {s} {.. glo
3da0: 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 bal i.
3db0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
3dc0: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
3dd0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
3de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3df0: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
3e00: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
3e10: 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s.
3e20: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
3e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 } e
3e40: 6c 73 65 20 7b 20 0a 09 20 20 20 20 20 20 20 20 lse { ..
3e50: 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 incr i.
3e60: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
3e70: 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 $l.
3e80: 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 }..}..set i 0..
3e90: 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 puts ready..set
3ea0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 timer [after 200
3eb0: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
3ec0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
3ed0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
3ee0: 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 close $f..puts "
3ef0: 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 done $i". }.
3f00: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3f10: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
3f20: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
3f30: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
3f40: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
3f50: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
3f60: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
3f70: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
3f80: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
3f90: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
3fa0: 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 Key 127.0.0.1 28
3fb0: 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 35]. fconfigu
3fc0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
3fd0: 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 68 20 line. catch
3fe0: 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 30 7d {..for {set x 0}
3ff0: 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 {$x < 50} {incr
4000: 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 x} {.. puts
4010: 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 $s "hello abcdef
4020: 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 ghijklmnop"..
4030: 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 20 20 gets $s..}.
4040: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 }. close $s.
4050: 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 78 20 catch {set x
4060: 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 [gets $f]}. c
4070: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4080: 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 x.} {done 50}..t
4090: 65 73 74 20 74 6c 73 49 4f 2d 32 2e 39 20 7b 73 est tlsIO-2.9 {s
40a0: 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 ocket conflict}
40b0: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
40c0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
40d0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
40e0: 61 63 63 65 70 74 20 32 38 32 38 5d 0a 20 20 20 accept 2828].
40f0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
4100: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
4110: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
4120: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
4130: 20 24 66 20 7b 70 61 63 6b 61 67 65 20 72 65 71 $f {package req
4140: 75 69 72 65 20 74 6c 73 3b 20 74 6c 73 3a 3a 73 uire tls; tls::s
4150: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4160: 63 65 70 74 20 32 38 32 38 7d 0a 20 20 20 20 63 cept 2828}. c
4170: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4180: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
4190: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
41a0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
41b0: 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 gets $f.
41c0: 61 66 74 65 72 20 31 30 30 0a 20 20 20 20 73 65 after 100. se
41d0: 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 t x [list [catch
41e0: 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 67 5d {close $f} msg]
41f0: 20 24 6d 73 67 5d 0a 20 20 20 20 63 6c 6f 73 65 $msg]. close
4200: 20 24 73 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $s. set x.}
4210: 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 {1 {couldn't ope
4220: 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 n socket: addres
4230: 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 s already in use
4240: 0a 20 20 20 20 77 68 69 6c 65 20 65 78 65 63 75 . while execu
4250: 74 69 6e 67 0a 22 3a 3a 73 6f 63 6b 65 74 20 2d ting."::socket -
4260: 73 65 72 76 65 72 20 7b 74 6c 73 3a 3a 5f 61 63 server {tls::_ac
4270: 63 65 70 74 20 7b 2d 73 65 72 76 65 72 20 31 7d cept {-server 1}
4280: 20 61 63 63 65 70 74 7d 20 32 38 32 38 22 0a 20 accept} 2828".
4290: 20 20 20 28 22 65 76 61 6c 22 20 62 6f 64 79 20 ("eval" body
42a0: 6c 69 6e 65 20 31 29 0a 20 20 20 20 69 6e 76 6f line 1). invo
42b0: 6b 65 64 20 66 72 6f 6d 20 77 69 74 68 69 6e 0a ked from within.
42c0: 22 65 76 61 6c 20 3a 3a 73 6f 63 6b 65 74 20 24 "eval ::socket $
42d0: 73 6f 70 74 73 22 0a 20 20 20 20 28 70 72 6f 63 sopts". (proc
42e0: 65 64 75 72 65 20 22 74 6c 73 3a 3a 73 6f 63 6b edure "tls::sock
42f0: 65 74 22 20 6c 69 6e 65 20 36 32 29 0a 20 20 20 et" line 62).
4300: 20 69 6e 76 6f 6b 65 64 20 66 72 6f 6d 20 77 69 invoked from wi
4310: 74 68 69 6e 0a 22 74 6c 73 3a 3a 73 6f 63 6b 65 thin."tls::socke
4320: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
4330: 20 32 38 32 38 22 0a 20 20 20 20 28 66 69 6c 65 2828". (file
4340: 20 22 73 63 72 69 70 74 22 20 6c 69 6e 65 20 31 "script" line 1
4350: 29 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d )}}..test tlsIO-
4360: 32 2e 31 30 20 7b 63 6c 6f 73 65 20 6f 6e 20 61 2.10 {close on a
4370: 63 63 65 70 74 2c 20 61 63 63 65 70 74 65 64 20 ccept, accepted
4380: 73 6f 63 6b 65 74 20 6c 69 76 65 73 7d 20 7b 73 socket lives} {s
4390: 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 7d 20 ocket knownBug}
43a0: 7b 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 {. set done 0
43b0: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
43c0: 61 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 after 20000 "set
43d0: 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 done timed_out"
43e0: 5d 0a 20 20 20 20 73 65 74 20 73 73 20 5b 74 6c ]. set ss [tl
43f0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
4400: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
4410: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
4420: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4430: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 ..-keyfile $serv
4440: 65 72 4b 65 79 20 32 38 33 30 5d 0a 20 20 20 20 erKey 2830].
4450: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
4460: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 p} {..global ss
4470: 0a 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c ..close $ss..fil
4480: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
4490: 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 09 le "readit $s"..
44a0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 fconfigure $s -t
44b0: 72 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 rans lf. }.
44c0: 20 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 proc readit {s
44d0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 } {..global done
44e0: 0a 09 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 ..gets $s..close
44f0: 20 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a $s..set done 1.
4500: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 73 }. set cs
4510: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
4520: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
4530: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4540: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4550: 24 63 6c 69 65 6e 74 4b 65 79 20 5b 69 6e 66 6f $clientKey [info
4560: 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 30 5d hostname] 2830]
4570: 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 73 0a 0a . close $cs..
4580: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
4590: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
45a0: 24 74 69 6d 65 72 0a 20 20 20 20 73 65 74 20 64 $timer. set d
45b0: 6f 6e 65 0a 7d 20 31 0a 0a 74 65 73 74 20 74 6c one.} 1..test tl
45c0: 73 49 4f 2d 32 2e 31 31 20 7b 64 65 74 65 63 74 sIO-2.11 {detect
45d0: 69 6e 67 20 6e 65 77 20 64 61 74 61 7d 20 7b 73 ing new data} {s
45e0: 6f 63 6b 65 74 20 6b 6e 6f 77 6e 42 75 67 7d 20 ocket knownBug}
45f0: 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 {. proc accep
4600: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
4610: 62 61 6c 20 73 6f 63 6b 0a 09 73 65 74 20 73 6f bal sock..set so
4620: 63 6b 20 24 73 0a 09 73 65 74 20 66 20 5b 6f 70 ck $s..set f [op
4630: 65 6e 20 61 77 62 2e 6c 6f 67 20 77 5d 0a 09 70 en awb.log w]..p
4640: 75 74 73 20 24 66 20 5b 63 61 74 63 68 20 7b 74 uts $f [catch {t
4650: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
4660: 6f 63 6b 7d 20 65 72 72 5d 0a 09 70 75 74 73 20 ock} err]..puts
4670: 24 66 20 22 65 72 72 3a 20 24 65 72 72 22 0a 09 $f "err: $err"..
4680: 70 75 74 73 20 24 66 20 22 5b 74 6c 73 3a 3a 73 puts $f "[tls::s
4690: 74 61 74 75 73 20 24 73 6f 63 6b 5d 22 0a 09 63 tatus $sock]"..c
46a0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 0a 20 lose $s. }..
46b0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
46c0: 6f 63 6b 65 74 20 2d 72 65 71 75 69 72 65 20 30 ocket -require 0
46d0: 20 2d 72 65 71 75 65 73 74 20 30 20 2d 73 65 72 -request 0 -ser
46e0: 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 ver accept -cert
46f0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
4700: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
4710: 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 \..-keyfile $se
4720: 72 76 65 72 4b 65 79 20 32 34 30 30 5d 0a 20 20 rverKey 2400].
4730: 20 20 73 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 set sock "".
4740: 20 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 set s2 [tls::s
4750: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
4760: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
4770: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
4780: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
4790: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 32 34 30 ey 127.0.0.1 240
47a0: 30 5d 0a 20 20 20 20 76 77 61 69 74 20 73 6f 63 0]. vwait soc
47b0: 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 6f k. puts $s2 o
47c0: 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 ne. flush $s2
47d0: 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 0a 20 . after 500.
47e0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
47f0: 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a ock -blocking 0.
4800: 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 20 5b set result [
4810: 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 gets $sock].
4820: 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 5b lappend result [
4830: 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 gets $sock].
4840: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
4850: 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 20 -blocking 1.
4860: 20 70 75 74 73 20 24 73 32 20 74 77 6f 0a 20 20 puts $s2 two.
4870: 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 20 flush $s2.
4880: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
4890: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 -blocking 0.
48a0: 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 lappend result
48b0: 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 [gets $sock].
48c0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
48d0: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 20 k -blocking 1.
48e0: 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 close $s2.
48f0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f close $s. clo
4900: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 73 65 74 se $sock. set
4910: 20 72 65 73 75 6c 74 0a 7d 20 7b 6f 6e 65 20 7b result.} {one {
4920: 7d 20 74 77 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 } two}..test tls
4930: 49 4f 2d 32 2e 31 32 20 7b 74 63 70 20 63 6f 6e IO-2.12 {tcp con
4940: 6e 65 63 74 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 nection; no cert
4950: 69 66 69 63 61 74 65 73 20 73 70 65 63 69 66 69 ificates specifi
4960: 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 ed} {socket stdi
4970: 6f 20 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 o pcCrash} {.
4980: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
4990: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
49a0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
49b0: 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 puts $f {. .
49c0: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
49d0: 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b tls..set timer [
49e0: 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 20 after 2000 "set
49f0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 x timed_out"]..s
4a00: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
4a10: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
4a20: 20 32 38 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 2828]..proc acc
4a30: 65 70 74 20 7b 66 69 6c 65 20 61 64 64 72 20 70 ept {file addr p
4a40: 6f 72 74 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 ort} {.. glob
4a50: 61 6c 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 al x.. set x
4a60: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
4a70: 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d 0a close $file..}.
4a80: 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 .puts ready..vwa
4a90: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
4aa0: 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 el $timer..close
4ab0: 20 24 66 0a 09 70 75 74 73 20 24 78 0a 20 20 20 $f..puts $x.
4ac0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
4ad0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
4ae0: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
4af0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
4b00: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
4b10: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
4b20: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
4b30: 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 t 127.0.0.1 2828
4b40: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
4b50: 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 set x $msg.
4b60: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
4b70: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
4b80: 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c s $f]. cl
4b90: 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 ose $msg. }.
4ba0: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
4bb0: 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 ts $f]. close
4bc0: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
4bd0: 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d 0a {ready done {}}.
4be0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 2e 31 20 .test tlsIO-3.1
4bf0: 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 {socket conflict
4c00: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
4c10: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
4c20: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
4c30: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
4c40: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
4c50: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
4c60: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
4c70: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
4c80: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
4c90: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
4ca0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
4cb0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
4cc0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
4cd0: 73 65 72 76 65 72 4b 65 79 20 32 38 32 38 20 5c serverKey 2828 \
4ce0: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
4cf0: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 67 65 ..puts ready..ge
4d00: 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 ts stdin..close
4d10: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
4d20: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
4d30: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
4d40: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
4d50: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
4d60: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
4d70: 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 et x [list [catc
4d80: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c h {tls::socket \
4d90: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
4da0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
4db0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
4dc0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
4dd0: 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 \. .-server a
4de0: 63 63 65 70 74 20 32 38 32 38 7d 20 6d 73 67 5d ccept 2828} msg]
4df0: 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 \...$msg]. p
4e00: 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 20 63 uts $f bye. c
4e10: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
4e20: 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 x.} {1 {couldn't
4e30: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
4e40: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
4e50: 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 use}}..test tls
4e60: 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 20 77 IO-3.2 {server w
4e70: 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 ith several clie
4e80: 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 nts} {socket std
4e90: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
4ea0: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
4eb0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
4ec0: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
4ed0: 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 f {. .package
4ee0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 require tls..se
4ef0: 74 20 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 t t1 [after 3000
4f00: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
4f10: 75 74 22 5d 0a 09 73 65 74 20 74 32 20 5b 61 66 ut"]..set t2 [af
4f20: 74 65 72 20 33 31 30 30 30 20 22 73 65 74 20 78 ter 31000 "set x
4f30: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
4f40: 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 30 t t3 [after 3200
4f50: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
4f60: 75 74 22 5d 0a 09 73 65 74 20 63 6f 75 6e 74 65 ut"]..set counte
4f70: 72 20 30 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 r 0. }. pu
4f80: 74 73 20 24 66 20 22 73 65 74 20 73 20 5c 5b 74 ts $f "set s \[t
4f90: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4fa0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
4fb0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
4fc0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
4fd0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
4fe0: 4b 65 79 20 32 38 32 38 20 5c 5d 22 0a 20 20 20 Key 2828 \]".
4ff0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
5000: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
5010: 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 {.. fileevent
5020: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
5030: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
5040: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
5050: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
5060: 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d }..proc echo {s}
5070: 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 {.. global
5080: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 x. s
5090: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 et l [gets $s].
50a0: 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 7b if {
50b0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 [eof $s]} {.
50c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
50d0: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
50e0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
50f0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
5100: 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 else {.
5110: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
5120: 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 $l.
5130: 20 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 }..}..puts read
5140: 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 y..vwait x..afte
5150: 72 20 63 61 6e 63 65 6c 20 24 74 31 0a 09 76 77 r cancel $t1..vw
5160: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
5170: 63 65 6c 20 24 74 32 0a 09 76 77 61 69 74 20 78 cel $t2..vwait x
5180: 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 ..after cancel $
5190: 74 33 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 t3..close $s..pu
51a0: 74 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 ts $x. }.
51b0: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
51c0: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
51d0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
51e0: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b test script]" r+
51f0: 5d 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 ]. set x [get
5200: 73 20 24 66 5d 0a 20 20 20 20 73 65 74 20 73 31 s $f]. set s1
5210: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
5220: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
5230: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
5240: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
5250: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
5260: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
5270: 32 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 2828]. fconfi
5280: 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 gure $s1 -buffer
5290: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
52a0: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
52b0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
52c0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
52d0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
52e0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
52f0: 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 y \.. 127.0.0
5300: 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 66 63 6f .1 2828]. fco
5310: 6e 66 69 67 75 72 65 20 24 73 32 20 2d 62 75 66 nfigure $s2 -buf
5320: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5330: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
5340: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
5350: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
5360: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
5370: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
5380: 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e tKey \.. 127.
5390: 30 2e 30 2e 31 20 32 38 32 38 5d 0a 20 20 20 20 0.0.1 2828].
53a0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d fconfigure $s3 -
53b0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
53c0: 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d for {set i 0}
53d0: 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 {$i < 100} {inc
53e0: 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 r i} {..puts $s1
53f0: 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 hello,s1..gets
5400: 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 $s1..puts $s2 he
5410: 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 73 32 llo,s2..gets $s2
5420: 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f ..puts $s3 hello
5430: 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 20 ,s3..gets $s3.
5440: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
5450: 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 1. close $s2.
5460: 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 close $s3.
5470: 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 lappend x [get
5480: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
5490: 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b $f. set x.} {
54a0: 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 65 73 ready done}..tes
54b0: 74 20 74 6c 73 49 4f 2d 34 2e 31 20 7b 73 65 72 t tlsIO-4.1 {ser
54c0: 76 65 72 20 77 69 74 68 20 73 65 76 65 72 61 6c ver with several
54d0: 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 clients} {socke
54e0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
54f0: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
5500: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5510: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
5520: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
5530: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
5540: 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 20 s..gets stdin.
5550: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
5560: 22 73 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f "set s \[tls::so
5570: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
5580: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
5590: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
55a0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
55b0: 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 20 5c 5d 27.0.0.1 2828 \]
55c0: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
55d0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
55e0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
55f0: 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 for {set i 0} {$
5600: 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 i < 100} {incr i
5610: 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 } {.. puts $s
5620: 20 68 65 6c 6c 6f 0a 09 20 20 20 20 67 65 74 73 hello.. gets
5630: 20 24 73 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 $s..}..close $s
5640: 0a 09 70 75 74 73 20 62 79 65 0a 09 67 65 74 73 ..puts bye..gets
5650: 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 stdin. }.
5660: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
5670: 74 20 70 31 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 t p1 [open "|[li
5680: 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 st $::tcltest::t
5690: 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 cltest script]"
56a0: 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 r+]. fconfigu
56b0: 72 65 20 24 70 31 20 2d 62 75 66 66 65 72 69 6e re $p1 -bufferin
56c0: 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 70 g line. set p
56d0: 32 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 2 [open "|[list
56e0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
56f0: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
5700: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5710: 24 70 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $p2 -buffering l
5720: 69 6e 65 0a 20 20 20 20 73 65 74 20 70 33 20 5b ine. set p3 [
5730: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
5740: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
5750: 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 script]" r+].
5760: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 33 fconfigure $p3
5770: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5780: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
5790: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
57a0: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
57b0: 72 69 6e 67 20 6c 69 6e 65 0a 09 66 69 6c 65 65 ring line..filee
57c0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
57d0: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
57e0: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 65 }. proc e
57f0: 63 68 6f 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 cho {s} {..globa
5800: 6c 20 78 0a 20 20 20 20 20 20 20 20 73 65 74 20 l x. set
5810: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 l [gets $s].
5820: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
5830: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
5840: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
5850: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
5860: 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b } else {
5870: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
5880: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
5890: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
58a0: 74 31 20 5b 61 66 74 65 72 20 33 30 30 30 30 20 t1 [after 30000
58b0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
58c0: 22 5d 0a 20 20 20 20 73 65 74 20 74 32 20 5b 61 "]. set t2 [a
58d0: 66 74 65 72 20 33 31 30 30 30 20 22 73 65 74 20 fter 31000 "set
58e0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
58f0: 20 20 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 set t3 [after
5900: 33 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 32000 "set x tim
5910: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 ed_out"]. set
5920: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
5930: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
5940: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
5950: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
5960: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
5970: 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 \. .-server
5980: 61 63 63 65 70 74 20 32 38 32 38 5d 0a 20 20 20 accept 2828].
5990: 20 70 75 74 73 20 24 70 31 20 6f 70 65 6e 0a 20 puts $p1 open.
59a0: 20 20 20 70 75 74 73 20 24 70 32 20 6f 70 65 6e puts $p2 open
59b0: 0a 20 20 20 20 70 75 74 73 20 24 70 33 20 6f 70 . puts $p3 op
59c0: 65 6e 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 en. vwait x.
59d0: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 vwait x. v
59e0: 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 wait x. after
59f0: 20 63 61 6e 63 65 6c 20 24 74 31 0a 20 20 20 20 cancel $t1.
5a00: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 after cancel $t2
5a10: 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 . after cance
5a20: 6c 20 24 74 33 0a 20 20 20 20 63 6c 6f 73 65 20 l $t3. close
5a30: 24 73 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a $s. set l "".
5a40: 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c lappend l [l
5a50: 69 73 74 20 70 31 20 5b 67 65 74 73 20 24 70 31 ist p1 [gets $p1
5a60: 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e ] $x]. lappen
5a70: 64 20 6c 20 5b 6c 69 73 74 20 70 32 20 5b 67 65 d l [list p2 [ge
5a80: 74 73 20 24 70 32 5d 20 24 78 5d 0a 20 20 20 20 ts $p2] $x].
5a90: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 lappend l [list
5aa0: 70 33 20 5b 67 65 74 73 20 24 70 33 5d 20 24 78 p3 [gets $p3] $x
5ab0: 5d 0a 20 20 20 20 70 75 74 73 20 24 70 31 20 62 ]. puts $p1 b
5ac0: 79 65 0a 20 20 20 20 70 75 74 73 20 24 70 32 20 ye. puts $p2
5ad0: 62 79 65 0a 20 20 20 20 70 75 74 73 20 24 70 33 bye. puts $p3
5ae0: 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 20 24 bye. close $
5af0: 70 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 32 p1. close $p2
5b00: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 33 0a 20 . close $p3.
5b10: 20 20 20 73 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 set l.} {{p1
5b20: 62 79 65 20 64 6f 6e 65 7d 20 7b 70 32 20 62 79 bye done} {p2 by
5b30: 65 20 64 6f 6e 65 7d 20 7b 70 33 20 62 79 65 20 e done} {p3 bye
5b40: 64 6f 6e 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 done}}..test tls
5b50: 49 4f 2d 34 2e 32 20 7b 62 79 74 65 20 6f 72 64 IO-4.2 {byte ord
5b60: 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 er problems, soc
5b70: 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f ket numbers, hto
5b80: 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ns} {socket} {.
5b90: 20 20 20 73 65 74 20 78 20 6f 6b 0a 20 20 20 20 set x ok.
5ba0: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
5bb0: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
5bc0: 64 6f 64 6f 20 30 78 33 30 30 30 7d 20 6d 73 67 dodo 0x3000} msg
5bd0: 5d 7d 20 7b 0a 09 73 65 74 20 78 20 24 6d 73 67 ]} {..set x $msg
5be0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 63 . } else {..c
5bf0: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
5c00: 20 20 20 20 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a set x.} ok..
5c10: 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 31 20 7b test tlsIO-5.1 {
5c20: 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c byte order probl
5c30: 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 ems, socket numb
5c40: 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b ers, htons} \..{
5c50: 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 socket unixOnly
5c60: 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 notRoot} {. s
5c70: 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f et x {couldn't o
5c80: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
5c90: 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 owner}. if {!
5ca0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
5cb0: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
5cc0: 20 30 78 31 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 0x1} msg]} {.
5cd0: 20 20 20 20 20 20 73 65 74 20 78 20 7b 68 74 6f set x {hto
5ce0: 6e 73 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 ns problem, shou
5cf0: 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 ld be disallowed
5d00: 2c 20 61 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e , are you runnin
5d10: 67 20 61 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 g as SU?}..close
5d20: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
5d30: 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 set x.} {couldn'
5d40: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e t open socket: n
5d50: 6f 74 20 6f 77 6e 65 72 7d 0a 74 65 73 74 20 74 ot owner}.test t
5d60: 6c 73 49 4f 2d 35 2e 32 20 7b 62 79 74 65 20 6f lsIO-5.2 {byte o
5d70: 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 rder problems, s
5d80: 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 ocket numbers, h
5d90: 74 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b tons} {socket} {
5da0: 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c . set x {coul
5db0: 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 dn't open socket
5dc0: 3a 20 70 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f : port number to
5dd0: 6f 20 68 69 67 68 7d 0a 20 20 20 20 69 66 20 7b o high}. if {
5de0: 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f ![catch {tls::so
5df0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
5e00: 6f 20 30 78 31 30 30 30 30 7d 20 6d 73 67 5d 7d o 0x10000} msg]}
5e10: 20 7b 0a 09 73 65 74 20 78 20 7b 70 6f 72 74 20 {..set x {port
5e20: 72 65 73 6f 6c 75 74 69 6f 6e 20 70 72 6f 62 6c resolution probl
5e30: 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 em, should be di
5e40: 73 61 6c 6c 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 sallowed}..close
5e50: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
5e60: 73 65 74 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 set x.} {couldn'
5e70: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 t open socket: p
5e80: 6f 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 ort number too h
5e90: 69 67 68 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d igh}.test tlsIO-
5ea0: 35 2e 33 20 7b 62 79 74 65 20 6f 72 64 65 72 20 5.3 {byte order
5eb0: 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 problems, socket
5ec0: 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d numbers, htons}
5ed0: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 6e 69 78 \..{socket unix
5ee0: 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a Only notRoot} {.
5ef0: 20 20 20 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 set x {could
5f00: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
5f10: 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 20 20 20 not owner}.
5f20: 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 74 6c 73 if {![catch {tls
5f30: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
5f40: 20 64 6f 64 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 dodo 21} msg]}
5f50: 7b 0a 09 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 {..set x {htons
5f60: 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 problem, should
5f70: 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 be disallowed, a
5f80: 72 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 re you running a
5f90: 73 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d s SU?}..close $m
5fa0: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
5fb0: 20 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f x.} {couldn't o
5fc0: 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 pen socket: not
5fd0: 6f 77 6e 65 72 7d 0a 0a 74 65 73 74 20 74 6c 73 owner}..test tls
5fe0: 49 4f 2d 36 2e 31 20 7b 61 63 63 65 70 74 20 63 IO-6.1 {accept c
5ff0: 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 7d 20 7b allback error} {
6000: 75 6e 65 78 70 6c 61 69 6e 65 64 46 61 69 6c 75 unexplainedFailu
6010: 72 65 20 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 re socket stdio
6020: 70 63 43 72 61 73 68 7d 20 7b 0a 20 20 20 20 72 pcCrash} {. r
6030: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
6040: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
6050: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
6060: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
6070: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
6080: 73 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 09 74 s..gets stdin..t
6090: 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 ls::socket 127.0
60a0: 2e 30 2e 31 20 32 38 34 38 0a 20 20 20 20 7d 0a .0.1 2848. }.
60b0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
60c0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
60d0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
60e0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
60f0: 22 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 " r+]. proc b
6100: 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 gerror args {..g
6110: 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 lobal x..set x $
6120: 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 args. }. p
6130: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
6140: 70 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d p} {expr 10 / 0}
6150: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
6160: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
6170: 61 63 63 65 70 74 20 32 38 34 38 5d 0a 20 20 20 accept 2848].
6180: 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 puts $f hello.
6190: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
61a0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
61b0: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
61c0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
61d0: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
61e0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
61f0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 close $s. r
6200: 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d ename bgerror {}
6210: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 . set x.} {{d
6220: 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a ivide by zero}}.
6230: 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 23 35 .# bug report #5
6240: 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 20 64 812 fconfigure d
6250: 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 76 61 oesn't return va
6260: 6c 75 65 20 66 6f 72 20 27 2d 70 65 65 72 6e 61 lue for '-peerna
6270: 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d me'..test tlsIO-
6280: 37 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 7.1 {testing soc
6290: 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 ket specific opt
62a0: 69 6f 6e 73 7d 20 7b 6b 6e 6f 77 6e 42 75 67 20 ions} {knownBug
62b0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a socket stdio} {.
62c0: 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 removeFile s
62d0: 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 cript. set f
62e0: 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a [open script w].
62f0: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
6300: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
6310: 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 ls. }. put
6320: 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 s $f "tls::socke
6330: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
6340: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
6350: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
6360: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
6370: 24 73 65 72 76 65 72 4b 65 79 20 32 38 32 30 22 $serverKey 2820"
6380: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
6390: 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 proc accept args
63a0: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 {.. global x
63b0: 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 .. set x done
63c0: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
63d0: 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 .set timer [afte
63e0: 72 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 r 10000 "set x t
63f0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 imed_out"]..vwai
6400: 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 t x..after cance
6410: 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 l $timer. }.
6420: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6430: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
6440: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
6450: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
6460: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a r]. gets $f.
6470: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6480: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
6490: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
64a0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
64b0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
64c0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
64d0: 32 37 2e 30 2e 30 2e 31 20 32 38 32 30 5d 0a 20 27.0.0.1 2820].
64e0: 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 set p [fconfi
64f0: 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e 61 6d gure $s -peernam
6500: 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a e]. close $s.
6510: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
6520: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
6530: 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 ppend l [string
6540: 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 compare [lindex
6550: 24 70 20 30 5d 20 31 32 37 2e 30 2e 30 2e 31 5d $p 0] 127.0.0.1]
6560: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
6570: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b string compare [
6580: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 32 38 32 lindex $p 2] 282
6590: 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 0]. lappend l
65a0: 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 7d 20 [llength $p].}
65b0: 7b 30 20 30 20 33 7d 0a 0a 23 20 62 75 67 20 72 {0 0 3}..# bug r
65c0: 65 70 6f 72 74 20 23 35 38 31 32 20 66 63 6f 6e eport #5812 fcon
65d0: 66 69 67 75 72 65 20 64 6f 65 73 6e 27 74 20 72 figure doesn't r
65e0: 65 74 75 72 6e 20 76 61 6c 75 65 20 66 6f 72 20 eturn value for
65f0: 27 2d 73 6f 63 6b 6e 61 6d 65 27 0a 0a 74 65 73 '-sockname'..tes
6600: 74 20 74 6c 73 49 4f 2d 37 2e 32 20 7b 74 65 73 t tlsIO-7.2 {tes
6610: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
6620: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 6b ific options} {k
6630: 6e 6f 77 6e 42 75 67 20 73 6f 63 6b 65 74 20 73 nownBug socket s
6640: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f tdio} {. remo
6650: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
6660: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
6670: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
6680: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
6690: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
66a0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 74 6c . puts $f "tl
66b0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
66c0: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
66d0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
66e0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
66f0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
6700: 65 79 20 32 38 32 31 22 0a 20 20 20 20 70 75 74 ey 2821". put
6710: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
6720: 65 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 20 ept args {..
6730: 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 global x.. se
6740: 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 t x done..}..put
6750: 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d s ready..set tim
6760: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
6770: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
6780: 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 "]..vwait x..aft
6790: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
67a0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
67b0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
67c0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
67d0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
67e0: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
67f0: 67 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 gets $f. set
6800: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
6810: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
6820: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
6830: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
6840: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
6850: 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 \.. 127.0.0.1
6860: 20 32 38 32 31 5d 0a 20 20 20 20 73 65 74 20 70 2821]. set p
6870: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 [fconfigure $s
6880: 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 63 -sockname]. c
6890: 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 lose $s. clos
68a0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 22 e $f. set l "
68b0: 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ". lappend l
68c0: 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 [llength $p].
68d0: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 lappend l [lind
68e0: 65 78 20 24 70 20 30 5d 0a 20 20 20 20 6c 61 70 ex $p 0]. lap
68f0: 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 65 pend l [string e
6900: 71 75 61 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 qual [lindex $p
6910: 32 5d 20 32 38 32 31 5d 0a 7d 20 7b 33 20 31 32 2] 2821].} {3 12
6920: 37 2e 30 2e 30 2e 31 20 30 7d 0a 0a 74 65 73 74 7.0.0.1 0}..test
6930: 20 74 6c 73 49 4f 2d 37 2e 33 20 7b 74 65 73 74 tlsIO-7.3 {test
6940: 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 69 ing socket speci
6950: 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 6f fic options} {so
6960: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
6970: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
6980: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
6990: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
69a0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
69b0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 $serverKey \.
69c0: 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 .-server accep
69d0: 74 20 32 38 32 32 5d 0a 20 20 20 20 73 65 74 20 t 2822]. set
69e0: 6c 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 l [fconfigure $s
69f0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
6a00: 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 6c 6c update. ll
6a10: 65 6e 67 74 68 20 24 6c 0a 7d 20 31 32 0a 0a 23 ength $l.} 12..#
6a20: 20 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 bug report #581
6a30: 32 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 2 fconfigure doe
6a40: 73 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 sn't return valu
6a50: 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 e for '-sockname
6a60: 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e '..test tlsIO-7.
6a70: 34 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 4 {testing socke
6a80: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
6a90: 6e 73 7d 20 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f ns} {knownBug so
6aa0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
6ab0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
6ac0: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
6ad0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
6ae0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
6af0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 $serverKey \.
6b00: 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 .-server accep
6b10: 74 20 32 38 32 33 5d 0a 20 20 20 20 70 72 6f 63 t 2823]. proc
6b20: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
6b30: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 {..global x..set
6b40: 20 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 x [fconfigure $
6b50: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 09 63 6c s -sockname]..cl
6b60: 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 ose $s. }.
6b70: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
6b80: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
6b90: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
6ba0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
6bb0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
6bc0: 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f 20 68 y \. .[info h
6bd0: 6f 73 74 6e 61 6d 65 5d 20 32 38 32 33 5d 0a 20 ostname] 2823].
6be0: 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 set timer [af
6bf0: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
6c00: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
6c10: 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 74 vwait x. aft
6c20: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
6c30: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
6c40: 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 close $s1.
6c50: 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 set l "". lap
6c60: 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 pend l [lindex $
6c70: 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 x 2] [llength $x
6c80: 5d 0a 7d 20 7b 32 38 32 33 20 33 7d 0a 0a 23 20 ].} {2823 3}..#
6c90: 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 32 bug report #5812
6ca0: 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 73 fconfigure does
6cb0: 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 65 n't return value
6cc0: 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 27 for '-sockname'
6cd0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 35 ..test tlsIO-7.5
6ce0: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
6cf0: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
6d00: 73 7d 20 7b 6b 6e 6f 77 6e 42 75 67 20 73 6f 63 s} {knownBug soc
6d10: 6b 65 74 20 75 6e 69 78 4f 72 50 63 7d 20 7b 0a ket unixOrPc} {.
6d20: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6d30: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
6d40: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
6d50: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
6d60: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
6d70: 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 Key \. .-serv
6d80: 65 72 20 61 63 63 65 70 74 20 32 38 32 39 5d 0a er accept 2829].
6d90: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
6da0: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
6db0: 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e l x..set x [fcon
6dc0: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e figure $s -sockn
6dd0: 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 ame]..close $s.
6de0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
6df0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
6e00: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
6e10: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
6e20: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
6e30: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 clientKey \.
6e40: 09 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 39 5d .127.0.0.1 2829]
6e50: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
6e60: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
6e70: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
6e80: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 vwait x. a
6e90: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
6ea0: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a er. close $s.
6eb0: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
6ec0: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
6ed0: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 append l [lindex
6ee0: 20 24 78 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 $x 0] [lindex $
6ef0: 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 x 2] [llength $x
6f00: 5d 0a 7d 20 7b 31 32 37 2e 30 2e 30 2e 31 20 32 ].} {127.0.0.1 2
6f10: 38 32 39 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 829 3}..test tls
6f20: 49 4f 2d 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 IO-8.1 {testing
6f30: 2d 61 73 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 -async flag on s
6f40: 6f 63 6b 65 74 73 7d 20 7b 65 6d 70 74 79 20 73 ockets} {empty s
6f50: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 74 ocket} {. # t
6f60: 65 73 74 20 73 65 65 6d 73 20 74 6f 20 68 61 6e est seems to han
6f70: 67 20 2d 2d 20 61 77 62 20 36 2f 32 2f 32 30 30 g -- awb 6/2/200
6f80: 30 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 68 0. # NOTE: Th
6f90: 69 73 20 74 65 73 74 20 6d 61 79 20 66 61 69 6c is test may fail
6fa0: 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 73 on some Solaris
6fb0: 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 20 49 66 2.4 systems. If
6fc0: 20 69 74 20 64 6f 65 73 2c 0a 20 20 20 20 23 20 it does,. #
6fd0: 63 68 65 63 6b 20 74 68 61 74 20 79 6f 75 20 68 check that you h
6fe0: 61 76 65 20 74 68 65 73 65 20 70 61 74 63 68 65 ave these patche
6ff0: 73 20 69 6e 73 74 61 6c 6c 65 64 20 28 75 73 69 s installed (usi
7000: 6e 67 20 73 68 6f 77 72 65 76 20 2d 70 29 3a 0a ng showrev -p):.
7010: 20 20 20 20 23 0a 20 20 20 20 23 20 31 30 31 39 #. # 1019
7020: 30 37 2d 30 35 2c 20 31 30 31 39 32 35 2d 30 32 07-05, 101925-02
7030: 2c 20 31 30 31 39 34 35 2d 31 34 2c 20 31 30 31 , 101945-14, 101
7040: 39 35 39 2d 30 33 2c 20 31 30 31 39 36 39 2d 30 959-03, 101969-0
7050: 35 2c 20 31 30 31 39 37 33 2d 30 33 2c 0a 20 20 5, 101973-03,.
7060: 20 20 23 20 31 30 31 39 37 37 2d 30 33 2c 20 31 # 101977-03, 1
7070: 30 31 39 38 31 2d 30 32 2c 20 31 30 31 39 38 35 01981-02, 101985
7080: 2d 30 31 2c 20 31 30 32 30 30 31 2d 30 33 2c 20 -01, 102001-03,
7090: 31 30 32 30 30 33 2d 30 31 2c 20 31 30 32 30 30 102003-01, 10200
70a0: 37 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 32 30 7-01,. # 1020
70b0: 31 31 2d 30 32 2c 20 31 30 32 30 32 34 2d 30 31 11-02, 102024-01
70c0: 2c 20 31 30 32 30 33 39 2d 30 31 2c 20 31 30 32 , 102039-01, 102
70d0: 30 34 34 2d 30 31 2c 20 31 30 32 30 34 38 2d 30 044-01, 102048-0
70e0: 31 2c 20 31 30 32 30 36 32 2d 30 33 2c 0a 20 20 1, 102062-03,.
70f0: 20 20 23 20 31 30 32 30 36 36 2d 30 34 2c 20 31 # 102066-04, 1
7100: 30 32 30 37 30 2d 30 31 2c 20 31 30 32 31 30 35 02070-01, 102105
7110: 2d 30 31 2c 20 31 30 32 31 35 33 2d 30 33 2c 20 -01, 102153-03,
7120: 31 30 32 32 31 36 2d 30 31 2c 20 31 30 32 32 33 102216-01, 10223
7130: 32 2d 30 31 2c 0a 20 20 20 20 23 20 31 30 31 38 2-01,. # 1018
7140: 37 38 2d 30 33 2c 20 31 30 31 38 37 39 2d 30 31 78-03, 101879-01
7150: 2c 20 31 30 31 38 38 30 2d 30 33 2c 20 31 30 31 , 101880-03, 101
7160: 39 33 33 2d 30 31 2c 20 31 30 31 39 35 30 2d 30 933-01, 101950-0
7170: 31 2c 20 31 30 32 30 33 30 2d 30 31 2c 0a 20 20 1, 102030-01,.
7180: 20 20 23 20 31 30 32 30 35 37 2d 30 38 2c 20 31 # 102057-08, 1
7190: 30 32 31 34 30 2d 30 31 2c 20 31 30 31 39 32 30 02140-01, 101920
71a0: 2d 30 32 2c 20 31 30 31 39 32 31 2d 30 39 2c 20 -02, 101921-09,
71b0: 31 30 31 39 32 32 2d 30 37 2c 20 31 30 31 39 32 101922-07, 10192
71c0: 33 2d 30 33 0a 20 20 20 20 23 0a 20 20 20 20 23 3-03. #. #
71d0: 20 49 66 20 61 66 74 65 72 20 69 6e 73 74 61 6c If after instal
71e0: 6c 69 6e 67 20 74 68 65 73 65 20 70 61 74 63 68 ling these patch
71f0: 65 73 20 79 6f 75 20 61 72 65 20 73 74 69 6c 6c es you are still
7200: 20 65 78 70 65 72 69 65 6e 63 69 6e 67 20 61 0a experiencing a.
7210: 20 20 20 20 23 20 70 72 6f 62 6c 65 6d 2c 20 70 # problem, p
7220: 6c 65 61 73 65 20 65 6d 61 69 6c 20 6a 79 6c 40 lease email jyl@
7230: 65 6e 67 2e 73 75 6e 2e 63 6f 6d 2e 20 57 65 20 eng.sun.com. We
7240: 68 61 76 65 20 6e 6f 74 20 6f 62 73 65 72 76 65 have not observe
7250: 64 20 74 68 69 73 0a 20 20 20 20 23 20 66 61 69 d this. # fai
7260: 6c 75 72 65 20 6f 6e 20 53 6f 6c 61 72 69 73 20 lure on Solaris
7270: 32 2e 35 2c 20 73 6f 20 61 6e 6f 74 68 65 72 20 2.5, so another
7280: 6f 70 74 69 6f 6e 20 28 69 6e 73 74 65 61 64 20 option (instead
7290: 6f 66 20 69 6e 73 74 61 6c 6c 69 6e 67 0a 20 20 of installing.
72a0: 20 20 23 20 74 68 65 73 65 20 70 61 74 63 68 65 # these patche
72b0: 73 29 20 69 73 20 74 6f 20 75 70 67 72 61 64 65 s) is to upgrade
72c0: 20 74 6f 20 53 6f 6c 61 72 69 73 20 32 2e 35 2e to Solaris 2.5.
72d0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
72e0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
72f0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
7300: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7310: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
7320: 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 rKey \. .-ser
7330: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 30 5d ver accept 2830]
7340: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
7350: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 {s a p} {..glob
7360: 61 6c 20 78 0a 09 70 75 74 73 20 24 73 20 62 79 al x..puts $s by
7370: 65 0a 09 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 e..close $s..set
7380: 20 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 x done. }.
7390: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
73a0: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
73b0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
73c0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
73d0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
73e0: 65 79 20 5c 0a 09 2d 61 73 79 6e 63 20 5b 69 6e ey \..-async [in
73f0: 66 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 fo hostname] 283
7400: 30 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 0]. vwait x.
7410: 20 20 20 73 65 74 20 7a 20 5b 67 65 74 73 20 24 set z [gets $
7420: 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 s1]. close $s
7430: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
7440: 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 0a 0a set z.} bye..
7450: 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 20 7b test tlsIO-9.1 {
7460: 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f 75 73 testing spurious
7470: 20 65 76 65 6e 74 73 7d 20 7b 65 6d 70 74 79 20 events} {empty
7480: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 socket} {. #
7490: 6c 6f 63 6b 73 20 75 70 20 0a 20 20 20 20 73 65 locks up . se
74a0: 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 t len 0. set
74b0: 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 spurious 0. s
74c0: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 et done 0. pr
74d0: 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 oc readlittle {s
74e0: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 } {..global spur
74f0: 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 ious done len..s
7500: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d et l [read $s 1]
7510: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 ..if {[string le
7520: 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b ngth $l] == 0} {
7530: 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 .. if {![eof
7540: 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 $s]} {...incr sp
7550: 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c urious.. } el
7560: 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a se {...close $s.
7570: 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 ..set done 1..
7580: 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 }..} else {..
7590: 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 incr len [str
75a0: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 ing length $l]..
75b0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
75c0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
75d0: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
75e0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 -buffering none
75f0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 6f 66 66 0a 09 -blocking off..
7600: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
7610: 64 61 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 dable [list read
7620: 6c 69 74 74 6c 65 20 24 73 5d 0a 20 20 20 20 7d little $s]. }
7630: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
7640: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
7650: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
7660: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7670: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
7680: 72 4b 65 79 20 5c 0a 20 20 20 09 2d 73 65 72 76 rKey \. .-serv
7690: 65 72 20 61 63 63 65 70 74 20 32 38 33 31 5d 0a er accept 2831].
76a0: 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a set c [tls::
76b0: 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 socket \..-certf
76c0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
76d0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
76e0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
76f0: 4b 65 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 6f Key \. .[info
7700: 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 31 5d hostname] 2831]
7710: 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
7720: 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 line $c 01234567
7730: 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 8901234567890123
7740: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
7750: 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 0123456789. c
7760: 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 lose $c. set
7770: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
7780: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
7790: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
77a0: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
77b0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
77c0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
77d0: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
77e0: 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 $len.} {0 50}..t
77f0: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 est tlsIO-9.2 {t
7800: 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 esting async wri
7810: 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 te, fileevents,
7820: 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 flush on close}
7830: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
7840: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 22 22 et firstblock ""
7850: 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 . for {set i
7860: 30 7d 20 7b 24 69 20 3c 20 35 7d 20 7b 69 6e 63 0} {$i < 5} {inc
7870: 72 20 69 7d 20 7b 73 65 74 20 66 69 72 73 74 62 r i} {set firstb
7880: 6c 6f 63 6b 20 22 61 24 66 69 72 73 74 62 6c 6f lock "a$firstblo
7890: 63 6b 24 66 69 72 73 74 62 6c 6f 63 6b 22 7d 0a ck$firstblock"}.
78a0: 20 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c set secondbl
78b0: 6f 63 6b 20 22 22 0a 20 20 20 20 66 6f 72 20 7b ock "". for {
78c0: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
78d0: 36 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 73 6} {incr i} {..s
78e0: 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 et secondblock "
78f0: 62 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 b$secondblock$se
7900: 63 6f 6e 64 62 6c 6f 63 6b 22 0a 20 20 20 20 7d condblock". }
7910: 0a 70 75 74 73 20 22 66 69 72 73 74 62 6c 6f 63 .puts "firstbloc
7920: 6b 20 3d 20 20 5b 73 74 72 69 6e 67 20 6c 65 6e k = [string len
7930: 67 74 68 20 24 66 69 72 73 74 62 6c 6f 63 6b 5d gth $firstblock]
7940: 22 0a 70 75 74 73 20 22 73 65 63 6f 6e 64 62 6c ".puts "secondbl
7950: 6f 63 6b 20 3d 20 5b 73 74 72 69 6e 67 20 6c 65 ock = [string le
7960: 6e 67 74 68 20 24 73 65 63 6f 6e 64 62 6c 6f 63 ngth $secondbloc
7970: 6b 5d 22 0a 20 20 20 20 73 65 74 20 6c 20 5b 74 k]". set l [t
7980: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 ls::socket \..-c
7990: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
79a0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
79b0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
79c0: 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d rverKey \. .-
79d0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
79e0: 33 32 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 32]. proc acc
79f0: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
7a00: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
7a10: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 6c ocking 0 -transl
7a20: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
7a30: 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 2d size 16384 \...-
7a40: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
7a50: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
7a60: 64 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 20 dable "readable
7a70: 24 73 22 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s". }. pr
7a80: 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 oc readable {s}
7a90: 7b 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 {..set l [gets $
7aa0: 73 5d 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 s]..fileevent $s
7ab0: 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a 09 61 66 readable {}..af
7ac0: 74 65 72 20 31 30 30 30 20 72 65 73 70 6f 6e 64 ter 1000 respond
7ad0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 $s. }. pr
7ae0: 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 7b oc respond {s} {
7af0: 0a 09 67 6c 6f 62 61 6c 20 66 69 72 73 74 62 6c ..global firstbl
7b00: 6f 63 6b 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 ock..puts -nonew
7b10: 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c line $s $firstbl
7b20: 6f 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 20 ock..after 1000
7b30: 77 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 20 writedata $s.
7b40: 20 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 }. proc writ
7b50: 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f edata {s} {..glo
7b60: 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a bal secondblock.
7b70: 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 .puts -nonewline
7b80: 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b $s $secondblock
7b90: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
7ba0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
7bb0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 :socket \..-cert
7bc0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
7bd0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
7be0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
7bf0: 74 4b 65 79 20 5c 0a 20 20 20 20 09 5b 69 6e 66 tKey \. .[inf
7c00: 6f 20 68 6f 73 74 6e 61 6d 65 5d 20 32 38 33 32 o hostname] 2832
7c10: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
7c20: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 $s -blocking 0
7c30: 2d 74 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 -trans lf -buffe
7c40: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
7c50: 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 t count 0. pu
7c60: 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 ts $s hello.
7c70: 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d 20 proc readit {s}
7c80: 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 {..global count
7c90: 64 6f 6e 65 0a 09 73 65 74 20 6c 20 5b 72 65 61 done..set l [rea
7ca0: 64 20 24 73 5d 0a 09 69 6e 63 72 20 63 6f 75 6e d $s]..incr coun
7cb0: 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 t [string length
7cc0: 20 24 6c 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 $l]..if {[eof $
7cd0: 73 5d 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 s]} {.. close
7ce0: 20 24 73 0a 09 20 20 20 20 73 65 74 20 64 6f 6e $s.. set don
7cf0: 65 20 31 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 e 1..}. }.
7d00: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
7d10: 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 adable "readit $
7d20: 73 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 s". set timer
7d30: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
7d40: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
7d50: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f t"]. vwait do
7d60: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
7d70: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
7d80: 6c 6f 73 65 20 24 6c 0a 20 20 20 20 73 65 74 20 lose $l. set
7d90: 63 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 74 count.} 65566..t
7da0: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 est tlsIO-9.3 {t
7db0: 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b esting EOF stick
7dc0: 79 6e 65 73 73 7d 20 7b 65 6d 70 74 79 20 73 6f yness} {empty so
7dd0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 68 61 cket} {. # ha
7de0: 6e 67 73 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 ngs. proc cou
7df0: 6e 74 5f 74 6f 5f 65 6f 66 20 7b 73 7d 20 7b 0a nt_to_eof {s} {.
7e00: 09 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f .global count do
7e10: 6e 65 20 74 69 6d 65 72 0a 09 73 65 74 20 6c 20 ne timer..set l
7e20: 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b [gets $s]..if {[
7e30: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
7e40: 69 6e 63 72 20 63 6f 75 6e 74 0a 09 20 20 20 20 incr count..
7e50: 69 66 20 7b 24 63 6f 75 6e 74 20 3e 20 39 7d 20 if {$count > 9}
7e60: 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 {...close $s...s
7e70: 65 74 20 64 6f 6e 65 20 74 72 75 65 0a 09 09 73 et done true...s
7e80: 65 74 20 63 6f 75 6e 74 20 7b 65 6f 66 20 69 73 et count {eof is
7e90: 20 73 74 69 63 6b 79 7d 0a 09 09 61 66 74 65 72 sticky}...after
7ea0: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
7eb0: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
7ec0: 20 20 20 70 72 6f 63 20 74 69 6d 65 72 70 72 6f proc timerpro
7ed0: 63 20 7b 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 c {} {..global d
7ee0: 6f 6e 65 20 63 6f 75 6e 74 20 63 0a 09 73 65 74 one count c..set
7ef0: 20 64 6f 6e 65 20 74 72 75 65 0a 09 73 65 74 20 done true..set
7f00: 63 6f 75 6e 74 20 7b 74 69 6d 65 72 20 77 65 6e count {timer wen
7f10: 74 20 6f 66 66 2c 20 65 6f 66 20 69 73 20 6e 6f t off, eof is no
7f20: 74 20 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 t sticky}..close
7f30: 20 24 63 0a 20 20 20 20 7d 09 0a 20 20 20 20 73 $c. }.. s
7f40: 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 73 et count 0. s
7f50: 65 74 20 64 6f 6e 65 20 66 61 6c 73 65 0a 20 20 et done false.
7f60: 20 20 70 72 6f 63 20 77 72 69 74 65 5f 74 68 65 proc write_the
7f70: 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 7b 0a 09 70 n_close {s} {..p
7f80: 75 74 73 20 24 73 20 62 79 65 0a 09 63 6c 6f 73 uts $s bye..clos
7f90: 65 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 e $s. }. p
7fa0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
7fb0: 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 p} {..fconfigure
7fc0: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
7fd0: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
7fe0: 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 lf..fileevent $
7ff0: 73 20 77 72 69 74 61 62 6c 65 20 22 77 72 69 74 s writable "writ
8000: 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 24 73 22 e_then_close $s"
8010: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
8020: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8030: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
8040: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
8050: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
8060: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 20 20 20 $serverKey \.
8070: 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 .-server accept
8080: 20 32 38 33 33 5d 0a 20 20 20 20 73 65 74 20 63 2833]. set c
8090: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
80a0: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
80b0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
80c0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
80d0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
80e0: 20 09 5b 69 6e 66 6f 20 68 6f 73 74 6e 61 6d 65 .[info hostname
80f0: 5d 20 32 38 33 33 5d 0a 20 20 20 20 66 63 6f 6e ] 2833]. fcon
8100: 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b figure $c -block
8110: 69 6e 67 20 6f 66 66 20 2d 62 75 66 66 65 72 69 ing off -bufferi
8120: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
8130: 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 tion lf. file
8140: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
8150: 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 e "count_to_eof
8160: 24 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c". set time
8170: 72 20 5b 61 66 74 65 72 20 31 30 30 30 20 74 69 r [after 1000 ti
8180: 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 merproc]. vwa
8190: 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 it done. clos
81a0: 65 20 24 73 0a 20 20 20 20 73 65 74 20 63 6f 75 e $s. set cou
81b0: 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 nt.} {eof is sti
81c0: 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 cky}..removeFile
81d0: 20 73 63 72 69 70 74 0a 0a 74 65 73 74 20 74 6c script..test tl
81e0: 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e sIO-10.1 {testin
81f0: 67 20 73 6f 63 6b 65 74 20 61 63 63 65 70 74 20 g socket accept
8200: 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 callback error h
8210: 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 andling} {socket
8220: 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 6f 74 65 } {. set gote
8230: 72 72 6f 72 20 30 0a 20 20 20 20 70 72 6f 63 20 rror 0. proc
8240: 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 67 6c bgerror args {gl
8250: 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 obal goterror; s
8260: 65 74 20 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 et goterror 1}.
8270: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
8280: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
8290: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
82a0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
82b0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
82c0: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
82d0: 72 20 61 63 63 65 70 74 20 32 38 39 38 5d 0a 20 r accept 2898].
82e0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
82f0: 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 s a p} {close $s
8300: 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 ; error}. set
8310: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
8320: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
8330: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
8340: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8350: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
8360: 31 32 37 2e 30 2e 30 2e 31 20 32 38 39 38 5d 0a 127.0.0.1 2898].
8370: 20 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 vwait goterr
8380: 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a or. close $s.
8390: 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 close $c.
83a0: 20 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 set goterror.}
83b0: 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 1..test tlsIO-11
83c0: 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 .1 {tcp connecti
83d0: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 on} {socket doTe
83e0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
83f0: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
8400: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 ommand "set caCe
8410: 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 rt $caCert".
8420: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8430: 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 serverCert $ser
8440: 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e verCert". sen
8450: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
8460: 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 ientCert $client
8470: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
8480: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
8490: 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 rKey $serverKey"
84a0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
84b0: 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 "set clientKey
84c0: 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 $clientKey".
84d0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
84e0: 65 74 20 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 et socket9_1_tes
84f0: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
8500: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
8510: 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cept \...-certfi
8520: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 5c le $serverCert \
8530: 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 ...-cafile $caCe
8540: 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 rt \...-keyfile
8550: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 32 $serverKey \...2
8560: 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 834]..proc accep
8570: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
8580: 20 70 75 74 73 20 24 73 20 64 6f 6e 65 0a 09 20 puts $s done..
8590: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
85a0: 65 20 24 73 0a 09 20 20 20 20 63 6c 6f 73 65 20 e $s.. close
85b0: 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 $s..}. }.
85c0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
85d0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
85e0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
85f0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
8600: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
8610: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
8620: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 34 5d teServerIP 2834]
8630: 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 73 . set r [gets
8640: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
8650: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
8660: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
8670: 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 9_1_test_server}
8680: 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e . set r.} don
8690: 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 e..test tlsIO-11
86a0: 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 .2 {client speci
86b0: 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 7b fies its port} {
86c0: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
86d0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
86e0: 7b 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e {. sendComman
86f0: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
8700: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
8710: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
8720: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
8730: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
8740: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
8750: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
8760: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
8770: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
8780: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
8790: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
87a0: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
87b0: 6e 74 4b 65 79 22 0a 20 20 20 20 69 66 20 7b 5b ntKey". if {[
87c0: 69 6e 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 info exists port
87d0: 5d 7d 20 7b 0a 09 69 6e 63 72 20 70 6f 72 74 0a ]} {..incr port.
87e0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 } else {..se
87f0: 74 20 70 6f 72 74 20 5b 65 78 70 72 20 32 30 34 t port [expr 204
8800: 38 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 5d 0a 8 + [pid]%1024].
8810: 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f }. sendCo
8820: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
8830: 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 ket9_2_test_serv
8840: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
8850: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
8860: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
8870: 72 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 rverCert \...-ca
8880: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
8890: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
88a0: 72 4b 65 79 20 5c 0a 09 20 20 20 20 32 38 33 35 rKey \.. 2835
88b0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
88c0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
88d0: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
88e0: 09 20 20 20 20 70 75 74 73 20 24 73 20 24 70 0a . puts $s $p.
88f0: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d . close $s..}
8900: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
8910: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
8920: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
8930: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
8940: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
8950: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
8960: 0a 09 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 .. -myport $p
8970: 6f 72 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 ort $remoteServe
8980: 72 49 50 20 32 38 33 35 5d 0a 20 20 20 20 73 65 rIP 2835]. se
8990: 74 20 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 t r [gets $s].
89a0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
89b0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
89c0: 65 20 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 e $socket9_2_tes
89d0: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 69 66 t_server}. if
89e0: 20 7b 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b {$r == $port} {
89f0: 0a 09 73 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a ..set result ok.
8a00: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 } else {..se
8a10: 74 20 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a t result broken.
8a20: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 72 65 }. set re
8a30: 73 75 6c 74 0a 7d 20 6f 6b 0a 74 65 73 74 20 74 sult.} ok.test t
8a40: 6c 73 49 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e lsIO-11.3 {tryin
8a50: 67 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f g to connect, no
8a60: 20 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 server} {socket
8a70: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
8a80: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
8a90: 73 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 set status ok.
8aa0: 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 if {![catch {s
8ab0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
8ac0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
8ad0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
8ae0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
8af0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
8b00: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
8b10: 65 53 65 72 76 65 72 49 70 20 32 38 33 36 5d 7d eServerIp 2836]}
8b20: 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 ]} {..if {![catc
8b30: 68 20 7b 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a h {gets $s}]} {.
8b40: 09 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 . set status
8b50: 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 broken..}..close
8b60: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
8b70: 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 t status.} ok..t
8b80: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b est tlsIO-11.4 {
8b90: 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 remote echo, one
8ba0: 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 line} {socket d
8bb0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
8bc0: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
8bd0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 ndCommand "set c
8be0: 61 43 65 72 74 20 24 63 61 43 65 72 74 22 0a 20 aCert $caCert".
8bf0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
8c00: 73 65 74 20 73 65 72 76 65 72 43 65 72 74 20 24 set serverCert $
8c10: 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 20 20 serverCert".
8c20: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8c30: 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 6c 69 clientCert $cli
8c40: 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 65 6e entCert". sen
8c50: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 dCommand "set se
8c60: 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 72 4b rverKey $serverK
8c70: 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d ey". sendComm
8c80: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 4b and "set clientK
8c90: 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 ey $clientKey".
8ca0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
8cb0: 0a 20 20 20 20 09 67 6c 6f 62 61 6c 20 73 65 72 . .global ser
8cc0: 76 65 72 43 65 72 74 0a 09 67 6c 6f 62 61 6c 20 verCert..global
8cd0: 63 61 43 65 72 74 0a 09 67 6c 6f 62 61 6c 20 73 caCert..global s
8ce0: 65 72 76 65 72 4b 65 79 0a 09 73 65 74 20 73 6f erverKey..set so
8cf0: 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 cket10_6_test_se
8d00: 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 rver [tls::socke
8d10: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
8d20: 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 09 $serverCert \...
8d30: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
8d40: 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 \...-keyfile $se
8d50: 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 rverKey \...-ser
8d60: 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 5d ver accept 2836]
8d70: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
8d80: 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 a p} {.. tls
8d90: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 ::handshake $s..
8da0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
8db0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
8dc0: 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 echo $s].. fc
8dd0: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 onfigure $s -buf
8de0: 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 fering line -tra
8df0: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d nslation crlf..}
8e00: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
8e10: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
8e20: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b ts $s].. if {
8e30: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
8e40: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
8e50: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 se {...puts $s $
8e60: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 l.. }..}.
8e70: 7d 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 }. set f [tls
8e80: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
8e90: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
8ea0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
8eb0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
8ec0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
8ed0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
8ee0: 20 32 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 2836]. fconf
8ef0: 69 67 75 72 65 20 24 66 20 2d 74 72 61 6e 73 6c igure $f -transl
8f00: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 ation crlf -buff
8f10: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 ering line. p
8f20: 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 uts $f hello.
8f30: 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 66 5d set r [gets $f]
8f40: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
8f50: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
8f60: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 lose $socket10_6
8f70: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
8f80: 20 20 73 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a set r.} hello.
8f90: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 .test tlsIO-11.5
8fa0: 20 7b 72 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 {remote echo, 5
8fb0: 30 20 6c 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 0 lines} {socket
8fc0: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
8fd0: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
8fe0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
8ff0: 20 63 61 43 65 72 74 20 24 63 61 43 65 72 74 22 caCert $caCert"
9000: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9010: 20 22 73 65 74 20 73 65 72 76 65 72 43 65 72 74 "set serverCert
9020: 20 24 73 65 72 76 65 72 43 65 72 74 22 0a 20 20 $serverCert".
9030: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 sendCommand "s
9040: 65 74 20 63 6c 69 65 6e 74 43 65 72 74 20 24 63 et clientCert $c
9050: 6c 69 65 6e 74 43 65 72 74 22 0a 20 20 20 20 73 lientCert". s
9060: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
9070: 73 65 72 76 65 72 4b 65 79 20 24 73 65 72 76 65 serverKey $serve
9080: 72 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 6f rKey". sendCo
9090: 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e mmand "set clien
90a0: 74 4b 65 79 20 24 63 6c 69 65 6e 74 4b 65 79 22 tKey $clientKey"
90b0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
90c0: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 31 30 {..set socket10
90d0: 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b _7_test_server [
90e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
90f0: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d ver accept \...-
9100: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
9110: 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 Cert \...-cafile
9120: 20 24 63 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 $caCert \...-ke
9130: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
9140: 20 5c 0a 09 09 32 38 33 36 5d 0a 09 70 72 6f 63 \...2836]..proc
9150: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
9160: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 {.. tls::hand
9170: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 shake $s.. fi
9180: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
9190: 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 ble [list echo $
91a0: 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 s].. fconfigu
91b0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
91c0: 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 line -translati
91d0: 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 on crlf..}..proc
91e0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
91f0: 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d set l [gets $s]
9200: 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 .. if {[eof $
9210: 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 s]} {...close $s
9220: 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 .. } else {..
9230: 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 .puts $s $l..
9240: 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 }..}. }.
9250: 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b set f [tls::sock
9260: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
9270: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
9280: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9290: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
92a0: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
92b0: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d teServerIP 2836]
92c0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
92d0: 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $f -translation
92e0: 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 crlf -buffering
92f0: 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 line. for {se
9300: 74 20 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c t cnt 0} {$cnt <
9310: 20 35 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 50} {incr cnt}
9320: 7b 0a 09 70 75 74 73 20 24 66 20 22 68 65 6c 6c {..puts $f "hell
9330: 6f 2c 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b 73 o, $cnt"..if {[s
9340: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 67 tring compare [g
9350: 65 74 73 20 24 66 5d 20 22 68 65 6c 6c 6f 2c 20 ets $f] "hello,
9360: 24 63 6e 74 22 5d 20 21 3d 20 30 7d 20 7b 0a 09 $cnt"] != 0} {..
9370: 20 20 20 20 62 72 65 61 6b 0a 09 7d 0a 20 20 20 break..}.
9380: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
9390: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
93a0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
93b0: 5f 37 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a _7_test_server}.
93c0: 20 20 20 20 73 65 74 20 63 6e 74 0a 7d 20 35 30 set cnt.} 50
93d0: 0a 0a 23 20 4d 61 63 69 6e 74 6f 73 68 20 73 6f ..# Macintosh so
93e0: 63 6b 65 74 73 20 63 61 6e 20 68 61 76 65 20 6d ckets can have m
93f0: 6f 72 65 20 74 68 61 6e 20 6f 6e 65 20 73 65 72 ore than one ser
9400: 76 65 72 20 70 65 72 20 70 6f 72 74 0a 69 66 20 ver per port.if
9410: 7b 24 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 {$tcl_platform(p
9420: 6c 61 74 66 6f 72 6d 29 20 3d 3d 20 22 6d 61 63 latform) == "mac
9430: 69 6e 74 6f 73 68 22 7d 20 7b 0a 20 20 20 20 73 intosh"} {. s
9440: 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c et conflictResul
9450: 74 20 7b 30 20 32 38 33 36 7d 0a 7d 20 65 6c 73 t {0 2836}.} els
9460: 65 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 e {. set conf
9470: 6c 69 63 74 52 65 73 75 6c 74 20 7b 31 20 7b 63 lictResult {1 {c
9480: 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 ouldn't open soc
9490: 6b 65 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 ket: address alr
94a0: 65 61 64 79 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a eady in use}}.}.
94b0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 36 .test tlsIO-11.6
94c0: 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 {socket conflic
94d0: 74 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 t} {socket doTes
94e0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
94f0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 31 er} {. set s1
9500: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9510: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9520: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
9530: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9540: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
9550: 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 .. -server ac
9560: 63 65 70 74 20 32 38 33 36 5d 0a 20 20 20 20 69 cept 2836]. i
9570: 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 73 f {[catch {set s
9580: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 2 [tls::socket \
9590: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
95a0: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
95b0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
95c0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
95d0: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
95e0: 63 63 65 70 74 20 32 38 33 36 5d 7d 20 6d 73 67 ccept 2836]} msg
95f0: 5d 7d 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 ]} {..set result
9600: 20 5b 6c 69 73 74 20 31 20 24 6d 73 67 5d 0a 20 [list 1 $msg].
9610: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 } else {..set
9620: 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 30 20 result [list 0
9630: 5b 6c 69 6e 64 65 78 20 5b 66 63 6f 6e 66 69 67 [lindex [fconfig
9640: 75 72 65 20 24 73 32 20 2d 73 6f 63 6b 6e 61 6d ure $s2 -socknam
9650: 65 5d 20 32 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 e] 2]]..close $s
9660: 32 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 2. }. clos
9670: 65 20 24 73 31 0a 20 20 20 20 73 65 74 20 72 65 e $s1. set re
9680: 73 75 6c 74 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 sult.} $conflict
9690: 52 65 73 75 6c 74 0a 0a 74 65 73 74 20 74 6c 73 Result..test tls
96a0: 49 4f 2d 31 31 2e 37 20 7b 73 65 72 76 65 72 20 IO-11.7 {server
96b0: 77 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 with several cli
96c0: 65 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ents} {socket do
96d0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
96e0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
96f0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
9700: 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f socket10_9_test_
9710: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
9720: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
9730: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
9740: 64 5d 20 63 65 72 74 73 20 73 65 72 76 65 72 2e d] certs server.
9750: 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 pem] \...-cafile
9760: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 [file join [pwd
9770: 5d 20 63 65 72 74 73 20 63 61 46 69 6c 65 2e 70 ] certs caFile.p
9780: 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 em] \...-keyfile
9790: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 [file join [pwd
97a0: 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 65 6d ] certs skey.pem
97b0: 5d 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 ] \...-server ac
97c0: 63 65 70 74 20 32 38 33 36 5d 0a 09 70 72 6f 63 cept 2836]..proc
97d0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
97e0: 7b 0a 09 20 20 20 20 23 20 68 61 6e 64 73 68 61 {.. # handsha
97f0: 6b 65 20 6c 6f 63 6b 73 20 75 70 20 74 68 65 20 ke locks up the
9800: 74 68 72 65 65 20 73 79 6e 63 68 72 6f 6e 6f 75 three synchronou
9810: 73 20 63 6c 69 65 6e 74 73 0a 09 20 20 20 20 23 s clients.. #
9820: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
9830: 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 $s.. fconfigu
9840: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
9850: 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 line.. filee
9860: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
9870: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
9880: 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 .}..proc echo {s
9890: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b } {.. set l [
98a0: 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 gets $s].. if
98b0: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
98c0: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
98d0: 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 else {...puts $s
98e0: 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 $l.. }..}.
98f0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b }. set s1 [
9900: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9910: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
9920: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
9930: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9940: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
9950: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
9960: 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 63 rIP 2836]. fc
9970: 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 onfigure $s1 -bu
9980: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
9990: 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f set s2 [tls::so
99a0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
99b0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
99c0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
99d0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
99e0: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 ntKey \.. $re
99f0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 32 38 33 moteServerIP 283
9a00: 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 6]. fconfigur
9a10: 65 20 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 e $s2 -buffering
9a20: 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 line. set s3
9a30: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9a40: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
9a50: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
9a60: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9a70: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
9a80: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
9a90: 76 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 verIP 2836].
9aa0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d fconfigure $s3 -
9ab0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
9ac0: 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d for {set i 0}
9ad0: 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 {$i < 100} {inc
9ae0: 72 20 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 r i} {..puts $s1
9af0: 20 68 65 6c 6c 6f 2c 73 31 0a 09 67 65 74 73 20 hello,s1..gets
9b00: 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 $s1..puts $s2 he
9b10: 6c 6c 6f 2c 73 32 0a 09 67 65 74 73 20 24 73 32 llo,s2..gets $s2
9b20: 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 6f ..puts $s3 hello
9b30: 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 20 ,s3..gets $s3.
9b40: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
9b50: 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 1. close $s2.
9b60: 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 close $s3.
9b70: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
9b80: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 lose $socket10_9
9b90: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
9ba0: 20 20 73 65 74 20 69 0a 7d 20 31 30 30 20 20 20 set i.} 100
9bb0: 20 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 ..test tlsIO-11
9bc0: 2e 38 20 7b 63 6c 69 65 6e 74 20 77 69 74 68 20 .8 {client with
9bd0: 73 65 76 65 72 61 6c 20 73 65 72 76 65 72 73 7d several servers}
9be0: 20 7b 65 6d 70 74 79 20 73 6f 63 6b 65 74 20 64 {empty socket d
9bf0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
9c00: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 Server} {. #
9c10: 74 68 69 73 20 6f 6e 65 20 73 65 65 6d 73 20 74 this one seems t
9c20: 6f 20 68 61 6e 67 20 2d 2d 20 61 77 62 20 36 2f o hang -- awb 6/
9c30: 32 2f 32 30 30 30 0a 20 20 20 20 73 65 6e 64 43 2/2000. sendC
9c40: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 31 ommand {..set s1
9c50: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
9c60: 09 09 2d 63 65 72 74 66 69 6c 65 20 5b 66 69 6c ..-certfile [fil
9c70: 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 e join [pwd] cer
9c80: 74 73 20 73 65 72 76 65 72 2e 70 65 6d 5d 20 5c ts server.pem] \
9c90: 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 69 6c 65 ...-cafile [file
9ca0: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9cb0: 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d 20 5c 0a s caFile.pem] \.
9cc0: 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 69 6c 65 ..-keyfile [file
9cd0: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 65 72 74 join [pwd] cert
9ce0: 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c 0a 09 09 s skey.pem] \...
9cf0: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
9d00: 34 30 30 33 22 20 34 30 30 33 5d 0a 09 73 65 74 4003" 4003]..set
9d10: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
9d20: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 5b \...-certfile [
9d30: 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 file join [pwd]
9d40: 63 65 72 74 73 20 73 65 72 76 65 72 2e 70 65 6d certs server.pem
9d50: 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 5b 66 ] \...-cafile [f
9d60: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9d70: 65 72 74 73 20 63 61 46 69 6c 65 2e 70 65 6d 5d erts caFile.pem]
9d80: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 5b 66 \...-keyfile [f
9d90: 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 63 ile join [pwd] c
9da0: 65 72 74 73 20 73 6b 65 79 2e 70 65 6d 5d 20 5c erts skey.pem] \
9db0: 0a 09 09 2d 73 65 72 76 65 72 20 22 61 63 63 65 ...-server "acce
9dc0: 70 74 20 34 30 30 34 22 20 34 30 30 34 5d 0a 09 pt 4004" 4004]..
9dd0: 73 65 74 20 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 set s3 [tls::soc
9de0: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
9df0: 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 e [file join [pw
9e00: 64 5d 20 63 65 72 74 73 20 73 65 72 76 65 72 2e d] certs server.
9e10: 70 65 6d 5d 20 5c 0a 09 09 2d 63 61 66 69 6c 65 pem] \...-cafile
9e20: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 [file join [pwd
9e30: 5d 20 63 65 72 74 73 20 63 61 46 69 6c 65 2e 70 ] certs caFile.p
9e40: 65 6d 5d 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 em] \...-keyfile
9e50: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 77 64 [file join [pwd
9e60: 5d 20 63 65 72 74 73 20 73 6b 65 79 2e 70 65 6d ] certs skey.pem
9e70: 5d 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 22 61 ] \...-server "a
9e80: 63 63 65 70 74 20 34 30 30 35 22 20 34 30 30 35 ccept 4005" 4005
9e90: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
9ea0: 6d 70 20 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 mp s a p} {..
9eb0: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
9ec0: 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 20 $s.. puts $s
9ed0: 24 6d 70 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 $mp.. close $
9ee0: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
9ef0: 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s1 [tls::sock
9f00: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
9f10: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
9f20: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9f30: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
9f40: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
9f50: 74 65 53 65 72 76 65 72 49 50 20 34 30 30 33 5d teServerIP 4003]
9f60: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
9f70: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9f80: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
9f90: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
9fa0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9fb0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
9fc0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
9fd0: 20 34 30 30 34 5d 0a 20 20 20 20 73 65 74 20 73 4004]. set s
9fe0: 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 3 [tls::socket \
9ff0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
a000: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
a010: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
a020: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
a030: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
a040: 72 76 65 72 49 50 20 34 30 30 35 5d 0a 20 20 20 rverIP 4005].
a050: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
a060: 70 70 65 6e 64 20 6c 20 5b 67 65 74 73 20 24 73 ppend l [gets $s
a070: 31 5d 20 5b 67 65 74 73 20 24 73 31 5d 20 5b 65 1] [gets $s1] [e
a080: 6f 66 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 of $s1] [gets $s
a090: 32 5d 20 5b 67 65 74 73 20 24 73 32 5d 20 5b 65 2] [gets $s2] [e
a0a0: 6f 66 20 24 73 32 5d 20 5c 0a 09 5b 67 65 74 73 of $s2] \..[gets
a0b0: 20 24 73 33 5d 20 5b 67 65 74 73 20 24 73 33 5d $s3] [gets $s3]
a0c0: 20 5b 65 6f 66 20 24 73 33 5d 0a 20 20 20 20 63 [eof $s3]. c
a0d0: 6c 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f lose $s1. clo
a0e0: 73 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 se $s2. close
a0f0: 20 24 73 33 0a 20 20 20 20 73 65 6e 64 43 6f 6d $s3. sendCom
a100: 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 65 20 24 73 mand {..close $s
a110: 31 0a 09 63 6c 6f 73 65 20 24 73 32 0a 09 63 6c 1..close $s2..cl
a120: 6f 73 65 20 24 73 33 0a 20 20 20 20 7d 0a 20 20 ose $s3. }.
a130: 20 20 73 65 74 20 6c 0a 7d 20 7b 34 30 30 33 20 set l.} {4003
a140: 7b 7d 20 31 20 34 30 30 34 20 7b 7d 20 31 20 34 {} 1 4004 {} 1 4
a150: 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 65 73 74 20 005 {} 1}..test
a160: 74 6c 73 49 4f 2d 31 31 2e 39 20 7b 61 63 63 65 tlsIO-11.9 {acce
a170: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
a180: 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 r} {socket doTes
a190: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a1a0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 20 er} {. set s
a1b0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
a1c0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
a1d0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
a1e0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a1f0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
a200: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
a210: 65 70 74 20 32 38 33 36 5d 0a 20 20 20 20 70 72 ept 2836]. pr
a220: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
a230: 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a } {expr 10 / 0}.
a240: 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f 72 proc bgerror
a250: 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c 20 args {..global
a260: 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a 20 x..set x $args.
a270: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d }. sendCom
a280: 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 mand "set caCert
a290: 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 $caCert". se
a2a0: 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 ndCommand "set s
a2b0: 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 65 erverCert $serve
a2c0: 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 rCert". sendC
a2d0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 ommand "set clie
a2e0: 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 ntCert $clientCe
a2f0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
a300: 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 4b and "set serverK
a310: 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 ey $serverKey".
a320: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 sendCommand "
a330: 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 set clientKey $c
a340: 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 69 66 lientKey". if
a350: 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 43 6f {[catch {sendCo
a360: 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 65 74 mmand {.. set
a370: 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f 6e 66 peername [fconf
a380: 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 6f 63 igure $callerSoc
a390: 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 09 ket -peername]..
a3a0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
a3b0: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
a3c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
a3d0: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 \...-cafile $ca
a3e0: 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c Cert \...-keyfil
a3f0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
a400: 20 20 20 20 09 5b 6c 69 6e 64 65 78 20 24 70 65 .[lindex $pe
a410: 65 72 6e 61 6d 65 20 30 5d 20 32 38 33 36 5d 0a ername 0] 2836].
a420: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
a430: 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 . }} msg]} {..
a440: 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 close $s..error
a450: 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 $msg. }. s
a460: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
a470: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
a480: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
a490: 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 it x. after c
a4a0: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
a4b0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 close $s. re
a4c0: 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a name bgerror {}.
a4d0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 set x.} {{di
a4e0: 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a vide by zero}}..
a4f0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 test tlsIO-11.10
a500: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
a510: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
a520: 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 s} {socket doTes
a530: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a540: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 6f er} {. sendCo
a550: 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 72 mmand "set caCer
a560: 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 73 t $caCert". s
a570: 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 endCommand "set
a580: 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 76 serverCert $serv
a590: 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 erCert". send
a5a0: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 Command "set cli
a5b0: 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 43 entCert $clientC
a5c0: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
a5d0: 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 72 mand "set server
a5e0: 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 0a Key $serverKey".
a5f0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a600: 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 "set clientKey $
a610: 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 clientKey". s
a620: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
a630: 74 20 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 t socket10_12_te
a640: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
a650: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
a660: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
a670: 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 61 \...-cafile $ca
a680: 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 6c Cert \...-keyfil
a690: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
a6a0: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
a6b0: 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 2836]..proc acce
a6c0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 pt {s a p} {clos
a6d0: 65 20 24 73 7d 0a 20 20 20 20 7d 0a 20 20 20 20 e $s}. }.
a6e0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
a6f0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
a700: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
a710: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a720: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a730: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
a740: 74 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d teServerIP 2836]
a750: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
a760: 66 69 67 75 72 65 20 24 73 20 2d 70 65 65 72 6e figure $s -peern
a770: 61 6d 65 5d 0a 20 20 20 20 73 65 74 20 6e 20 5b ame]. set n [
a780: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 fconfigure $s -s
a790: 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 ockname]. set
a7a0: 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e l "". lappen
a7b0: 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 32 d l [lindex $p 2
a7c0: 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 20 5b ] [llength $p] [
a7d0: 6c 6c 65 6e 67 74 68 20 24 70 5d 0a 20 20 20 20 llength $p].
a7e0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e close $s. sen
a7f0: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
a800: 24 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 $socket10_12_tes
a810: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
a820: 74 20 6c 0a 7d 20 7b 32 38 33 36 20 33 20 33 7d t l.} {2836 3 3}
a830: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
a840: 31 31 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 11 {testing spur
a850: 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b 65 6d ious events} {em
a860: 70 74 79 20 73 6f 63 6b 65 74 20 64 6f 54 65 73 pty socket doTes
a870: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
a880: 65 72 7d 20 7b 0a 20 20 20 20 23 20 68 61 6e 67 er} {. # hang
a890: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
a8a0: 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 63 d "set caCert $c
a8b0: 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 aCert". sendC
a8c0: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 ommand "set serv
a8d0: 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 65 erCert $serverCe
a8e0: 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d rt". sendComm
a8f0: 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 43 and "set clientC
a900: 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 22 ert $clientCert"
a910: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
a920: 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 20 "set serverKey
a930: 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 20 $serverKey".
a940: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
a950: 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 65 clientKey $clie
a960: 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 43 ntKey". sendC
a970: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
a980: 63 6b 65 74 31 30 5f 31 33 5f 74 65 73 74 5f 73 cket10_13_test_s
a990: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
a9a0: 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 et \...-certfile
a9b0: 20 24 73 65 72 76 65 72 43 65 72 74 20 5c 0a 09 $serverCert \..
a9c0: 09 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 .-cafile $caCert
a9d0: 20 5c 0a 09 09 2d 6b 65 79 66 69 6c 65 20 24 73 \...-keyfile $s
a9e0: 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 2d 73 65 erverKey \...-se
a9f0: 72 76 65 72 20 61 63 63 65 70 74 20 32 38 33 36 rver accept 2836
aa00: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
aa10: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
aa20: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
aa30: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
aa40: 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $s -translation
aa50: 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 20 20 61 "auto lf".. a
aa60: 66 74 65 72 20 31 30 30 20 77 72 69 74 65 73 6f fter 100 writeso
aa70: 6d 65 20 24 73 0a 09 7d 0a 09 70 72 6f 63 20 77 me $s..}..proc w
aa80: 72 69 74 65 73 6f 6d 65 20 7b 73 7d 20 7b 0a 09 ritesome {s} {..
aa90: 20 20 20 20 66 6f 72 20 7b 73 65 74 20 69 20 30 for {set i 0
aaa0: 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e } {$i < 100} {in
aab0: 63 72 20 69 7d 20 7b 0a 09 09 70 75 74 73 20 24 cr i} {...puts $
aac0: 73 20 22 6c 69 6e 65 20 24 69 20 66 72 6f 6d 20 s "line $i from
aad0: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 22 0a 09 remote server"..
aae0: 20 20 20 20 7d 0a 09 20 20 20 20 63 6c 6f 73 65 }.. close
aaf0: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
ab00: 20 73 65 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 set len 0. s
ab10: 65 74 20 73 70 75 72 69 6f 75 73 20 30 0a 20 20 et spurious 0.
ab20: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
ab30: 20 70 72 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 proc readlittle
ab40: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 {s} {..global s
ab50: 70 75 72 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e purious done len
ab60: 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 ..set l [read $s
ab70: 20 31 5d 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 1]..if {[string
ab80: 20 6c 65 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 length $l] == 0
ab90: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 } {.. if {![e
aba0: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 of $s]} {...incr
abb0: 20 73 70 75 72 69 6f 75 73 0a 09 20 20 20 20 7d spurious.. }
abc0: 20 65 6c 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 else {...close
abd0: 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 31 0a $s...set done 1.
abe0: 09 20 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b . }..} else {
abf0: 0a 09 20 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b .. incr len [
ac00: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
ac10: 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 ]..}. }. s
ac20: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
ac30: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
ac40: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
ac50: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
ac60: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
ac70: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
ac80: 65 53 65 72 76 65 72 49 50 20 32 38 33 36 5d 0a eServerIP 2836].
ac90: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
aca0: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 6c readable "readl
acb0: 69 74 74 6c 65 20 24 63 22 0a 20 20 20 20 73 65 ittle $c". se
acc0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
acd0: 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 0000 "set done t
ace0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
acf0: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 wait done. af
ad00: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
ad10: 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e r. sendComman
ad20: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
ad30: 31 30 5f 31 33 5f 74 65 73 74 5f 73 65 72 76 65 10_13_test_serve
ad40: 72 7d 0a 20 20 20 20 6c 69 73 74 20 24 73 70 75 r}. list $spu
ad50: 72 69 6f 75 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 rious $len.} {0
ad60: 32 36 39 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 2690}..test tlsI
ad70: 4f 2d 31 31 2e 31 32 20 7b 74 65 73 74 69 6e 67 O-11.12 {testing
ad80: 20 45 4f 46 20 73 74 69 63 6b 79 6e 65 73 73 7d EOF stickyness}
ad90: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
ada0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
adb0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 75 6e } {. set coun
adc0: 74 65 72 20 30 0a 20 20 20 20 73 65 74 20 64 6f ter 0. set do
add0: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 63 6f ne 0. proc co
ade0: 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 6c unt_up {s} {..gl
adf0: 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f 6e obal counter don
ae00: 65 20 61 66 74 65 72 5f 69 64 0a 09 73 65 74 20 e after_id..set
ae10: 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 l [gets $s]..if
ae20: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 {[eof $s]} {..
ae30: 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a 09 incr counter..
ae40: 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 72 if {$counter
ae50: 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 6f > 9} {...set do
ae60: 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b ne {EOF is stick
ae70: 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 y}...after cance
ae80: 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 09 63 6c l $after_id...cl
ae90: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d ose $s.. }..}
aea0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
aeb0: 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 timed_out {} {..
aec0: 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 73 global c done..s
aed0: 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f et done {timed_o
aee0: 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 73 ut, EOF is not s
aef0: 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 ticky}..close $c
af00: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
af10: 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 61 43 65 ommand "set caCe
af20: 72 74 20 24 63 61 43 65 72 74 22 0a 20 20 20 20 rt $caCert".
af30: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 sendCommand "set
af40: 20 73 65 72 76 65 72 43 65 72 74 20 24 73 65 72 serverCert $ser
af50: 76 65 72 43 65 72 74 22 0a 20 20 20 20 73 65 6e verCert". sen
af60: 64 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 63 6c dCommand "set cl
af70: 69 65 6e 74 43 65 72 74 20 24 63 6c 69 65 6e 74 ientCert $client
af80: 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f Cert". sendCo
af90: 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 76 65 mmand "set serve
afa0: 72 4b 65 79 20 24 73 65 72 76 65 72 4b 65 79 22 rKey $serverKey"
afb0: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
afc0: 20 22 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 20 "set clientKey
afd0: 24 63 6c 69 65 6e 74 4b 65 79 22 0a 20 20 20 20 $clientKey".
afe0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
aff0: 65 74 20 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 et socket10_14_t
b000: 65 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a est_server [tls:
b010: 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 :socket \...-cer
b020: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
b030: 74 20 5c 0a 09 09 2d 63 61 66 69 6c 65 20 24 63 t \...-cafile $c
b040: 61 43 65 72 74 20 5c 0a 09 09 2d 6b 65 79 66 69 aCert \...-keyfi
b050: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
b060: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
b070: 20 32 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 2836]..proc acc
b080: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
b090: 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b tls::handshak
b0a0: 65 20 24 73 0a 09 20 20 20 20 61 66 74 65 72 20 e $s.. after
b0b0: 31 30 30 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 100 close $s..}.
b0c0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 20 }. set c
b0d0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
b0e0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
b0f0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
b100: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
b110: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
b120: 20 20 20 20 09 24 72 65 6d 6f 74 65 53 65 72 76 .$remoteServ
b130: 65 72 49 50 20 32 38 33 36 5d 0a 20 20 20 20 66 erIP 2836]. f
b140: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
b150: 61 62 6c 65 20 22 63 6f 75 6e 74 5f 75 70 20 24 able "count_up $
b160: 63 22 0a 20 20 20 20 73 65 74 20 61 66 74 65 72 c". set after
b170: 5f 69 64 20 5b 61 66 74 65 72 20 31 30 30 30 20 _id [after 1000
b180: 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 20 20 20 76 timed_out]. v
b190: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 73 65 wait done. se
b1a0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
b1b0: 20 24 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 $socket10_14_te
b1c0: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
b1d0: 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 4f 46 20 69 et done.} {EOF i
b1e0: 73 20 73 74 69 63 6b 79 7d 0a 0a 74 65 73 74 20 s sticky}..test
b1f0: 74 6c 73 49 4f 2d 31 31 2e 31 33 20 7b 74 65 73 tlsIO-11.13 {tes
b200: 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 ting async write
b210: 2c 20 61 73 79 6e 63 20 66 6c 75 73 68 2c 20 61 , async flush, a
b220: 73 79 6e 63 20 63 6c 6f 73 65 7d 20 5c 0a 09 7b sync close} \..{
b230: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
b240: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
b250: 7b 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 {. proc readi
b260: 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 t {s} {..global
b270: 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 count done..set
b280: 6c 20 5b 72 65 61 64 20 24 73 5d 0a 09 69 6e 63 l [read $s]..inc
b290: 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 r count [string
b2a0: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 69 66 20 7b length $l]..if {
b2b0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 [eof $s]} {..
b2c0: 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 close $s.. s
b2d0: 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 et done 1..}.
b2e0: 20 7d 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 }. sendComma
b2f0: 6e 64 20 22 73 65 74 20 63 61 43 65 72 74 20 24 nd "set caCert $
b300: 63 61 43 65 72 74 22 0a 20 20 20 20 73 65 6e 64 caCert". send
b310: 43 6f 6d 6d 61 6e 64 20 22 73 65 74 20 73 65 72 Command "set ser
b320: 76 65 72 43 65 72 74 20 24 73 65 72 76 65 72 43 verCert $serverC
b330: 65 72 74 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d ert". sendCom
b340: 6d 61 6e 64 20 22 73 65 74 20 63 6c 69 65 6e 74 mand "set client
b350: 43 65 72 74 20 24 63 6c 69 65 6e 74 43 65 72 74 Cert $clientCert
b360: 22 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e ". sendComman
b370: 64 20 22 73 65 74 20 73 65 72 76 65 72 4b 65 79 d "set serverKey
b380: 20 24 73 65 72 76 65 72 4b 65 79 22 0a 20 20 20 $serverKey".
b390: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 22 73 65 sendCommand "se
b3a0: 74 20 63 6c 69 65 6e 74 4b 65 79 20 24 63 6c 69 t clientKey $cli
b3b0: 65 6e 74 4b 65 79 22 0a 20 20 20 20 73 65 6e 64 entKey". send
b3c0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 66 Command {..set f
b3d0: 69 72 73 74 62 6c 6f 63 6b 20 22 22 0a 09 66 6f irstblock ""..fo
b3e0: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
b3f0: 3c 20 35 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a < 5} {incr i} {.
b400: 09 09 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b ..set firstblock
b410: 20 22 61 24 66 69 72 73 74 62 6c 6f 63 6b 24 66 "a$firstblock$f
b420: 69 72 73 74 62 6c 6f 63 6b 22 0a 09 7d 0a 09 73 irstblock"..}..s
b430: 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 et secondblock "
b440: 22 0a 09 66 6f 72 20 7b 73 65 74 20 69 20 30 7d "..for {set i 0}
b450: 20 7b 24 69 20 3c 20 31 36 7d 20 7b 69 6e 63 72 {$i < 16} {incr
b460: 20 69 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 73 i} {.. set s
b470: 65 63 6f 6e 64 62 6c 6f 63 6b 20 22 62 24 73 65 econdblock "b$se
b480: 63 6f 6e 64 62 6c 6f 63 6b 24 73 65 63 6f 6e 64 condblock$second
b490: 62 6c 6f 63 6b 22 0a 09 7d 0a 09 73 65 74 20 6c block"..}..set l
b4a0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
b4b0: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
b4c0: 76 65 72 43 65 72 74 20 5c 0a 09 09 2d 63 61 66 verCert \...-caf
b4d0: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 09 ile $caCert \...
b4e0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
b4f0: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
b500: 61 63 63 65 70 74 20 32 38 34 35 5d 0a 09 70 72 accept 2845]..pr
b510: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
b520: 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 } {.. tls::ha
b530: 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 ndshake $s..
b540: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
b550: 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 locking 0 -trans
b560: 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 lation lf -buffe
b570: 72 73 69 7a 65 20 31 36 33 38 34 20 5c 0a 09 09 rsize 16384 \...
b580: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
b590: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
b5a0: 73 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 s readable "read
b5b0: 61 62 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f able $s"..}..pro
b5c0: 63 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b c readable {s} {
b5d0: 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 .. set l [get
b5e0: 73 20 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 s $s].. filee
b5f0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
b600: 20 7b 7d 0a 09 20 20 20 20 61 66 74 65 72 20 31 {}.. after 1
b610: 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 000 respond $s..
b620: 7d 0a 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 }..proc respond
b630: 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 {s} {.. globa
b640: 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 l firstblock..
b650: 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e puts -nonewlin
b660: 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b e $s $firstblock
b670: 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 .. after 1000
b680: 20 77 72 69 74 65 64 61 74 61 20 24 73 0a 09 7d writedata $s..}
b690: 0a 09 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 ..proc writedata
b6a0: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 {s} {.. glob
b6b0: 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 al secondblock..
b6c0: 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c puts -nonewl
b6d0: 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c ine $s $secondbl
b6e0: 6f 63 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 ock.. close $
b6f0: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
b700: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
b710: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
b720: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
b730: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
b740: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
b750: 65 79 20 5c 0a 20 20 20 20 09 24 72 65 6d 6f 74 ey \. .$remot
b760: 65 53 65 72 76 65 72 49 50 20 32 38 34 35 5d 0a eServerIP 2845].
b770: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
b780: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 s -blocking 0 -t
b790: 72 61 6e 73 20 6c 66 20 2d 62 75 66 66 65 72 69 rans lf -bufferi
b7a0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
b7b0: 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 74 73 count 0. puts
b7c0: 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 66 69 $s hello. fi
b7d0: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
b7e0: 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 22 0a ble "readit $s".
b7f0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
b800: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
b810: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
b820: 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a . vwait done.
b830: 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c after cancel
b840: 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 6e 64 $timer. send
b850: 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 Command {close $
b860: 6c 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 l}. set count
b870: 0a 7d 20 36 35 35 36 36 0a 0a 74 65 73 74 20 74 .} 65566..test t
b880: 6c 73 49 4f 2d 31 32 2e 31 20 7b 74 65 73 74 69 lsIO-12.1 {testi
b890: 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f ng inheritance o
b8a0: 66 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 73 f server sockets
b8b0: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 } \..{socket doT
b8c0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
b8d0: 72 76 65 72 7d 20 7b 0a 20 20 20 20 72 65 6d 6f rver} {. remo
b8e0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 veFile script1.
b8f0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
b900: 72 69 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 ript2.. # Scr
b910: 69 70 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 ipt1 is just a 1
b920: 30 20 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 0 second delay.
b930: 20 49 66 20 74 68 65 20 73 65 72 76 65 72 20 73 If the server s
b940: 6f 63 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 ocket. # is i
b950: 6e 68 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c nherited, it wil
b960: 6c 20 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 l be held open f
b970: 6f 72 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 or 10 seconds..
b980: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
b990: 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 cript1 w]. pu
b9a0: 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 ts $f {..after 1
b9b0: 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 0000 exit..vwait
b9c0: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
b9d0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
b9e0: 20 23 20 53 63 72 69 70 74 32 20 63 72 65 61 74 # Script2 creat
b9f0: 65 73 20 74 68 65 20 73 65 72 76 65 72 20 73 6f es the server so
ba00: 63 6b 65 74 2c 20 6c 61 75 6e 63 68 65 73 20 73 cket, launches s
ba10: 63 72 69 70 74 31 2c 0a 20 20 20 20 23 20 77 61 cript1,. # wa
ba20: 69 74 73 20 61 20 73 65 63 6f 6e 64 2c 20 61 6e its a second, an
ba30: 64 20 65 78 69 74 73 2e 20 20 54 68 65 20 73 65 d exits. The se
ba40: 72 76 65 72 20 73 6f 63 6b 65 74 20 77 69 6c 6c rver socket will
ba50: 20 6e 6f 77 0a 20 20 20 20 23 20 62 65 20 63 6c now. # be cl
ba60: 6f 73 65 64 20 75 6e 6c 65 73 73 20 73 63 72 69 osed unless scri
ba70: 70 74 31 20 69 6e 68 65 72 69 74 65 64 20 69 74 pt1 inherited it
ba80: 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 ... set f [op
ba90: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
baa0: 20 20 23 20 70 75 74 73 20 24 66 20 5b 6c 69 73 # puts $f [lis
bab0: 74 20 73 65 74 20 74 63 6c 74 65 73 74 20 24 3a t set tcltest $:
bac0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
bad0: 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b t]. puts $f [
bae0: 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 5b list set tclsh [
baf0: 69 6e 66 6f 20 6e 61 6d 65 6f 66 65 78 65 63 75 info nameofexecu
bb00: 74 61 62 6c 65 5d 5d 0a 20 20 20 20 70 75 74 73 table]]. puts
bb10: 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 $f {..package r
bb20: 65 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a 09 equire tcltest..
bb30: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
bb40: 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 tls. }. pu
bb50: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
bb60: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
bb70: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
bb80: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
bb90: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
bba0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
bbb0: 4b 65 79 20 32 38 32 38 20 5c 5d 22 0a 20 20 20 Key 2828 \]".
bbc0: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
bbd0: 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 61 accept { file a
bbe0: 64 64 72 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 ddr port } {..
bbf0: 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 0a 09 7d close $file..}
bc00: 0a 09 23 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 ..# exec $::tclt
bc10: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
bc20: 69 70 74 31 20 26 0a 09 65 78 65 63 20 24 74 63 ipt1 &..exec $tc
bc30: 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 63 lsh script1 &..c
bc40: 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 72 20 31 lose $f..after 1
bc50: 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 000 exit..vwait
bc60: 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 forever. }.
bc70: 20 20 63 6c 6f 73 65 20 24 66 0a 09 0a 20 20 20 close $f...
bc80: 20 23 20 4c 61 75 6e 63 68 20 73 63 72 69 70 74 # Launch script
bc90: 32 20 61 6e 64 20 77 61 69 74 20 35 20 73 65 63 2 and wait 5 sec
bca0: 6f 6e 64 73 0a 0a 20 20 20 20 23 20 65 78 65 63 onds.. # exec
bcb0: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
bcc0: 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 20 test script2 &.
bcd0: 20 20 20 65 78 65 63 20 5b 69 6e 66 6f 20 6e 61 exec [info na
bce0: 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 20 meofexecutable]
bcf0: 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 61 66 script2 &. af
bd00: 74 65 72 20 35 30 30 30 20 7b 20 73 65 74 20 6f ter 5000 { set o
bd10: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 20 7d k_to_proceed 1 }
bd20: 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f . vwait ok_to
bd30: 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 23 20 _proceed.. #
bd40: 49 66 20 77 65 20 63 61 6e 20 73 74 69 6c 6c 20 If we can still
bd50: 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 20 73 connect to the s
bd60: 65 72 76 65 72 2c 20 74 68 65 20 73 6f 63 6b 65 erver, the socke
bd70: 74 20 67 6f 74 20 69 6e 68 65 72 69 74 65 64 2e t got inherited.
bd80: 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 .. if {[catch
bd90: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a {tls::socket \.
bda0: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
bdb0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
bdc0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
bdd0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
bde0: 09 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 32 38 . 127.0.0.1 2828
bdf0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
be00: 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 {server socket
be10: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
be20: 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a d}. } else {.
be30: 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 .close $msg..set
be40: 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 x {server socke
be50: 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d t was inherited}
be60: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 72 65 6d 6f . }.. remo
be70: 76 65 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 veFile script1.
be80: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
be90: 72 69 70 74 32 0a 20 20 20 20 73 65 74 20 78 0a ript2. set x.
bea0: 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 } {server socket
beb0: 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 was not inherit
bec0: 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ed}..test tlsIO-
bed0: 31 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.2 {testing in
bee0: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 63 6c 69 heritance of cli
bef0: 65 6e 74 20 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 ent sockets} \..
bf00: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
bf10: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
bf20: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
bf30: 65 20 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 e script1. re
bf40: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 moveFile script2
bf50: 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 20 .. # Script1
bf60: 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 is just a 10 sec
bf70: 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 ond delay. If t
bf80: 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 he server socket
bf90: 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 . # is inheri
bfa0: 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 ted, it will be
bfb0: 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 held open for 10
bfc0: 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 seconds.. se
bfd0: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
bfe0: 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 1 w]. puts $f
bff0: 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 {..after 10000
c000: 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 exit..vwait fore
c010: 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ver. }. cl
c020: 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 ose $f.. # Sc
c030: 72 69 70 74 32 20 6f 70 65 6e 73 20 74 68 65 20 ript2 opens the
c040: 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 61 6e client socket an
c050: 64 20 77 72 69 74 65 73 20 74 6f 20 69 74 2e 20 d writes to it.
c060: 20 49 74 20 74 68 65 6e 0a 20 20 20 20 23 20 6c It then. # l
c070: 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 20 aunches script1
c080: 61 6e 64 20 65 78 69 74 73 2e 20 20 49 66 20 74 and exits. If t
c090: 68 65 20 63 68 69 6c 64 20 70 72 6f 63 65 73 73 he child process
c0a0: 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 0a 20 inherited the.
c0b0: 20 20 20 23 20 63 6c 69 65 6e 74 20 73 6f 63 6b # client sock
c0c0: 65 74 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 77 et, the socket w
c0d0: 69 6c 6c 20 73 74 69 6c 6c 20 62 65 20 6f 70 65 ill still be ope
c0e0: 6e 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f n... set f [o
c0f0: 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 pen script2 w].
c100: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
c110: 20 73 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 6f set tclsh [info
c120: 20 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c nameofexecutabl
c130: 65 5d 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 e]]. puts $f
c140: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
c150: 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d equire tls. }
c160: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
c170: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
c180: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
c190: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
c1a0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
c1b0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
c1c0: 30 2e 30 2e 31 20 32 38 32 39 20 5c 5d 22 0a 20 0.0.1 2829 \]".
c1d0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 65 78 puts $f {..ex
c1e0: 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 ec $tclsh script
c1f0: 31 20 26 0a 09 70 75 74 73 20 24 66 20 74 65 73 1 &..puts $f tes
c200: 74 69 6e 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 ting..flush $f..
c210: 61 66 74 65 72 20 31 30 30 30 20 65 78 69 74 0a after 1000 exit.
c220: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
c230: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
c240: 66 0a 0a 20 20 20 20 23 20 43 72 65 61 74 65 20 f.. # Create
c250: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
c260: 74 0a 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 t.. set serve
c270: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c r [tls::socket \
c280: 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
c290: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
c2a0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
c2b0: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 2d $serverKey \..-
c2c0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
c2d0: 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 29]. proc acc
c2e0: 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 ept { file host
c2f0: 70 6f 72 74 20 7d 20 7b 0a 0a 09 23 20 57 68 65 port } {...# Whe
c300: 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e n the client con
c310: 6e 65 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 nects, establish
c320: 20 74 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 the read handle
c330: 72 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 r..global server
c340: 0a 09 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a ..close $server.
c350: 09 66 69 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 .fileevent $file
c360: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
c370: 67 65 74 64 61 74 61 20 24 66 69 6c 65 5d 0a 09 getdata $file]..
c380: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 fconfigure $file
c390: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
c3a0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 72 65 -blocking 0..re
c3b0: 74 75 72 6e 0a 20 20 20 20 7d 0a 20 20 20 20 70 turn. }. p
c3c0: 72 6f 63 20 67 65 74 64 61 74 61 20 7b 20 66 69 roc getdata { fi
c3d0: 6c 65 20 7d 20 7b 0a 0a 09 23 20 52 65 61 64 20 le } {...# Read
c3e0: 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 20 61 handler on the a
c3f0: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 2e 0a ccepted socket..
c400: 09 67 6c 6f 62 61 6c 20 78 0a 09 67 6c 6f 62 61 .global x..globa
c410: 6c 20 66 61 69 6c 65 64 0a 09 73 65 74 20 73 74 l failed..set st
c420: 61 74 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 atus [catch {rea
c430: 64 20 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 09 d $file} data]..
c440: 69 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 if {$status != 0
c450: 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 78 20 7b } {.. set x {
c460: 72 65 61 64 20 66 61 69 6c 65 64 2c 20 65 72 72 read failed, err
c470: 6f 72 20 77 61 73 20 24 64 61 74 61 7d 0a 09 20 or was $data}..
c480: 20 20 20 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 catch { close
c490: 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 6c 73 65 $file }..} else
c4a0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 6f 6d 70 if {[string comp
c4b0: 61 72 65 20 7b 7d 20 24 64 61 74 61 5d 7d 20 7b are {} $data]} {
c4c0: 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c ..} elseif {[fbl
c4d0: 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a ocked $file]} {.
c4e0: 09 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 .} elseif {[eof
c4f0: 24 66 69 6c 65 5d 7d 20 7b 0a 09 20 20 20 20 69 $file]} {.. i
c500: 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 09 f {$failed} {...
c510: 73 65 74 20 78 20 7b 63 6c 69 65 6e 74 20 73 6f set x {client so
c520: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
c530: 65 64 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 ed}.. } else
c540: 7b 0a 09 09 73 65 74 20 78 20 7b 63 6c 69 65 6e {...set x {clien
c550: 74 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 t socket was not
c560: 20 69 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 inherited}..
c570: 20 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 }.. catch {
c580: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d close $file }..}
c590: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 else {.. set
c5a0: 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 x {impossible c
c5b0: 61 73 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 ase}.. catch
c5c0: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
c5d0: 09 7d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d .}..return. }
c5e0: 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 .. # If the s
c5f0: 6f 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 69 ocket doesn't hi
c600: 74 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 6e t end-of-file in
c610: 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 0a 5 seconds, the.
c620: 20 20 20 20 23 20 73 63 72 69 70 74 31 20 70 72 # script1 pr
c630: 6f 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 20 ocess must have
c640: 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 6c inherited the cl
c650: 69 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 ient... set f
c660: 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 ailed 0. afte
c670: 72 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 74 r 5000 [list set
c680: 20 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 20 failed 1]..
c690: 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 72 # Launch the scr
c6a0: 69 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 20 ipt2 process..
c6b0: 20 20 65 78 65 63 20 5b 69 6e 66 6f 20 6e 61 6d exec [info nam
c6c0: 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d 20 73 eofexecutable] s
c6d0: 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 76 77 cript2 &.. vw
c6e0: 61 69 74 20 78 0a 20 20 20 20 69 66 20 7b 21 24 ait x. if {!$
c6f0: 66 61 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 74 failed} {..vwait
c700: 20 66 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 20 failed. }.
c710: 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 removeFile scr
c720: 69 70 74 31 0a 20 20 20 20 72 65 6d 6f 76 65 46 ipt1. removeF
c730: 69 6c 65 20 73 63 72 69 70 74 32 0a 20 20 20 20 ile script2.
c740: 73 65 74 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 set x.} {client
c750: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
c760: 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 nherited}..test
c770: 74 6c 73 49 4f 2d 31 32 2e 33 20 7b 74 65 73 74 tlsIO-12.3 {test
c780: 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 ing inheritance
c790: 6f 66 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b of accepted sock
c7a0: 65 74 73 7d 20 5c 0a 09 7b 65 6d 70 74 79 20 73 ets} \..{empty s
c7b0: 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 ocket doTestsWit
c7c0: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b hRemoteServer} {
c7d0: 0a 20 20 20 20 23 20 68 61 6e 67 73 20 6f 6e 20 . # hangs on
c7e0: 4c 69 6e 75 78 0a 20 20 20 20 72 65 6d 6f 76 65 Linux. remove
c7f0: 46 69 6c 65 20 73 63 72 69 70 74 31 0a 20 20 20 File script1.
c800: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
c810: 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 5b pt2.. set f [
c820: 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a open script1 w].
c830: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 puts $f {..a
c840: 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a fter 10000 exit.
c850: 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 .vwait forever.
c860: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
c870: 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 f.. set f [op
c880: 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 en script2 w].
c890: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
c8a0: 73 65 74 20 74 63 6c 73 68 20 5b 69 6e 66 6f 20 set tclsh [info
c8b0: 6e 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 nameofexecutable
c8c0: 5d 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]]. puts $f {
c8d0: 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 . .package re
c8e0: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
c8f0: 20 20 20 20 70 75 74 73 20 24 66 20 22 63 61 74 puts $f "cat
c900: 63 68 20 7b 73 65 74 20 66 20 5c 5b 74 6c 73 3a ch {set f \[tls:
c910: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
c920: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
c930: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
c940: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
c950: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
c960: 20 32 39 33 30 20 5c 5d 7d 22 0a 20 20 20 20 70 2930 \]}". p
c970: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
c980: 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 ccept { file hos
c990: 74 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 t port } {..
c9a0: 67 6c 6f 62 61 6c 20 74 63 6c 73 68 0a 09 20 20 global tclsh..
c9b0: 20 20 70 75 74 73 20 24 66 69 6c 65 20 7b 74 65 puts $file {te
c9c0: 73 74 20 64 61 74 61 20 6f 6e 20 73 6f 63 6b 65 st data on socke
c9d0: 74 7d 0a 09 20 20 20 20 65 78 65 63 20 24 74 63 t}.. exec $tc
c9e0: 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 20 lsh script1 &..
c9f0: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 65 78 after 1000 ex
ca00: 69 74 0a 09 7d 0a 09 63 61 74 63 68 20 7b 76 77 it..}..catch {vw
ca10: 61 69 74 20 66 6f 72 65 76 65 72 7d 0a 20 20 20 ait forever}.
ca20: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
ca30: 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 . # Launch th
ca40: 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 e script2 proces
ca50: 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f s and connect to
ca60: 20 69 74 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f it. See how lo
ca70: 6e 67 0a 20 20 20 20 23 20 74 68 65 20 73 6f 63 ng. # the soc
ca80: 6b 65 74 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a ket stays open..
ca90: 20 20 20 20 65 78 65 63 20 5b 69 6e 66 6f 20 6e exec [info n
caa0: 61 6d 65 6f 66 65 78 65 63 75 74 61 62 6c 65 5d ameofexecutable]
cab0: 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 script2 &..
cac0: 61 66 74 65 72 20 31 30 30 30 20 73 65 74 20 6f after 1000 set o
cad0: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 k_to_proceed 1.
cae0: 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 vwait ok_to_p
caf0: 72 6f 63 65 65 64 0a 0a 20 20 20 20 73 65 74 20 roceed.. set
cb00: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c f [tls::socket \
cb10: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
cb20: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
cb30: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
cb40: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
cb50: 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 \.. 127.0.0.1
cb60: 20 32 39 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 2930]. fconf
cb70: 69 67 75 72 65 20 24 66 20 2d 62 75 66 66 65 72 igure $f -buffer
cb80: 69 6e 67 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 ing full -blocki
cb90: 6e 67 20 30 0a 20 20 20 20 66 69 6c 65 65 76 65 ng 0. fileeve
cba0: 6e 74 20 24 66 20 72 65 61 64 61 62 6c 65 20 5b nt $f readable [
cbb0: 6c 69 73 74 20 67 65 74 64 61 74 61 20 24 66 5d list getdata $f]
cbc0: 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 .. # If the s
cbd0: 6f 63 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 6f ocket is still o
cbe0: 70 65 6e 20 61 66 74 65 72 20 35 20 73 65 63 6f pen after 5 seco
cbf0: 6e 64 73 2c 20 74 68 65 20 73 63 72 69 70 74 31 nds, the script1
cc00: 20 70 72 6f 63 65 73 73 0a 20 20 20 20 23 20 6d process. # m
cc10: 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 ust have inherit
cc20: 65 64 20 74 68 65 20 61 63 63 65 70 74 65 64 20 ed the accepted
cc30: 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 socket... set
cc40: 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 failed 0. af
cc50: 74 65 72 20 35 30 30 30 20 73 65 74 20 66 61 69 ter 5000 set fai
cc60: 6c 65 64 20 31 0a 0a 20 20 20 20 70 72 6f 63 20 led 1.. proc
cc70: 67 65 74 64 61 74 61 20 7b 20 66 69 6c 65 20 7d getdata { file }
cc80: 20 7b 0a 0a 09 23 20 52 65 61 64 20 68 61 6e 64 {...# Read hand
cc90: 6c 65 72 20 6f 6e 20 74 68 65 20 63 6c 69 65 6e ler on the clien
cca0: 74 20 73 6f 63 6b 65 74 2e 0a 09 67 6c 6f 62 61 t socket...globa
ccb0: 6c 20 78 0a 09 67 6c 6f 62 61 6c 20 66 61 69 6c l x..global fail
ccc0: 65 64 0a 09 73 65 74 20 73 74 61 74 75 73 20 5b ed..set status [
ccd0: 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 6c catch {read $fil
cce0: 65 7d 20 64 61 74 61 5d 0a 09 69 66 20 7b 24 73 e} data]..if {$s
ccf0: 74 61 74 75 73 20 21 3d 20 30 7d 20 7b 0a 09 20 tatus != 0} {..
cd00: 20 20 20 73 65 74 20 78 20 7b 72 65 61 64 20 66 set x {read f
cd10: 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 ailed, error was
cd20: 20 24 64 61 74 61 7d 0a 09 20 20 20 20 63 61 74 $data}.. cat
cd30: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
cd40: 20 7d 0a 09 7d 20 65 6c 73 65 69 66 20 7b 5b 73 }..} elseif {[s
cd50: 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d tring compare {}
cd60: 20 24 64 61 74 61 5d 7d 20 7b 0a 09 7d 20 65 6c $data]} {..} el
cd70: 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 64 20 seif {[fblocked
cd80: 24 66 69 6c 65 5d 7d 20 7b 0a 09 7d 20 65 6c 73 $file]} {..} els
cd90: 65 69 66 20 7b 5b 65 6f 66 20 24 66 69 6c 65 5d eif {[eof $file]
cda0: 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 24 66 61 } {.. if {$fa
cdb0: 69 6c 65 64 7d 20 7b 0a 09 09 73 65 74 20 78 20 iled} {...set x
cdc0: 7b 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 {accepted socket
cdd0: 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d 0a was inherited}.
cde0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
cdf0: 73 65 74 20 78 20 7b 61 63 63 65 70 74 65 64 20 set x {accepted
ce00: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
ce10: 6e 68 65 72 69 74 65 64 7d 0a 09 20 20 20 20 7d nherited}.. }
ce20: 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 63 6c .. catch { cl
ce30: 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d 20 65 ose $file }..} e
ce40: 6c 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 78 lse {.. set x
ce50: 20 7b 69 6d 70 6f 73 73 69 62 6c 65 20 63 61 73 {impossible cas
ce60: 65 7d 0a 09 20 20 20 20 63 61 74 63 68 20 7b 20 e}.. catch {
ce70: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 09 7d close $file }..}
ce80: 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 7d 0a 20 ..return. }.
ce90: 20 20 20 0a 20 20 20 20 76 77 61 69 74 20 78 0a . vwait x.
cea0: 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 . removeFile
ceb0: 73 63 72 69 70 74 31 0a 20 20 20 20 72 65 6d 6f script1. remo
cec0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 32 0a 20 veFile script2.
ced0: 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 set x.} {acce
cee0: 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 pted socket was
cef0: 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a not inherited}..
cf00: 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 test tlsIO-13.1
cf10: 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 20 {Testing use of
cf20: 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 65 shared socket be
cf30: 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 64 tween two thread
cf40: 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 s} \..{socket te
cf50: 73 74 74 68 72 65 61 64 7d 20 7b 0a 0a 20 20 20 stthread} {..
cf60: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
cf70: 70 74 0a 20 20 20 20 74 68 72 65 61 64 52 65 61 pt. threadRea
cf80: 70 0a 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 p.. makeFile
cf90: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
cfa0: 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 equire tls..set
cfb0: 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d f [tls::socket -
cfc0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 32 38 server accept 28
cfd0: 32 38 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 28]..proc accept
cfe0: 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 {s a p} {.
cff0: 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 fileevent
d000: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
d010: 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 st echo $s].
d020: 20 20 20 20 20 20 20 20 66 63 6f 6e 66 69 67 75 fconfigu
d030: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
d040: 20 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a line. }.
d050: 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b .proc echo {s} {
d060: 0a 09 20 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a .. global i.
d070: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 set
d080: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 l [gets $s].
d090: 20 20 20 20 20 20 20 20 20 20 69 66 20 7b 5b 65 if {[e
d0a0: 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 of $s]} {.
d0b0: 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 globa
d0c0: 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 l x.
d0d0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
d0e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
d0f0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
d100: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 20 } else {
d110: 0a 09 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 .. incr
d120: 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
d130: 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 puts $s $l.
d140: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a }..}.
d150: 09 73 65 74 20 69 20 30 0a 09 76 77 61 69 74 20 .set i 0..vwait
d160: 78 0a 09 63 6c 6f 73 65 20 24 66 0a 0a 09 23 20 x..close $f...#
d170: 74 68 72 65 61 64 20 63 6c 65 61 6e 73 20 69 74 thread cleans it
d180: 73 65 6c 66 20 75 70 2e 0a 09 74 65 73 74 74 68 self up...testth
d190: 72 65 61 64 20 65 78 69 74 0a 20 20 20 20 7d 20 read exit. }
d1a0: 73 63 72 69 70 74 0a 20 20 20 20 0a 20 20 20 20 script. .
d1b0: 23 20 63 72 65 61 74 65 20 61 20 74 68 72 65 61 # create a threa
d1c0: 64 0a 20 20 20 20 73 65 74 20 73 65 72 76 65 72 d. set server
d1d0: 74 68 72 65 61 64 20 5b 74 65 73 74 74 68 72 65 thread [testthre
d1e0: 61 64 20 63 72 65 61 74 65 20 7b 20 73 6f 75 72 ad create { sour
d1f0: 63 65 20 73 63 72 69 70 74 20 7d 20 5d 0a 20 20 ce script } ].
d200: 20 20 75 70 64 61 74 65 0a 20 20 20 20 0a 20 20 update. .
d210: 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 after 1000.
d220: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
d230: 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 32 38 ket 127.0.0.1 28
d240: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
d250: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
d260: 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 line.. catch
d270: 20 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 6c {..puts $s "hel
d280: 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 73 lo"..gets $s res
d290: 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ult. }. cl
d2a0: 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 ose $s. updat
d2b0: 65 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 e.. after 200
d2c0: 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 0. lappend re
d2d0: 73 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 70 sult [threadReap
d2e0: 5d 0a 20 20 20 20 0a 20 20 20 20 73 65 74 20 72 ]. . set r
d2f0: 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 esult..} {hello
d300: 31 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 66 1}..# cleanup.if
d310: 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 {[string match
d320: 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f sock* $commandSo
d330: 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 cket] == 1} {.
d340: 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f puts $commandSo
d350: 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 6c 75 cket exit. flu
d360: 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 sh $commandSocke
d370: 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 t.}.catch {close
d380: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d $commandSocket}
d390: 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 72 .catch {close $r
d3a0: 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a 3a emoteProcChan}.:
d3b0: 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e 75 :tcltest::cleanu
d3c0: 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 74 64 pTests.flush std
d3d0: 6f 75 74 0a 72 65 74 75 72 6e 0a 0a out.return..