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 20 20 20 20 20 20 20 20 20 socket.
0030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0040: 20 2d 2a 2d 20 74 63 6c 20 2d 2a 2d 0a 23 0a 23 -*- tcl -*-.#.#
0050: 20 54 68 69 73 20 66 69 6c 65 20 63 6f 6e 74 61 This file conta
0060: 69 6e 73 20 61 20 63 6f 6c 6c 65 63 74 69 6f 6e ins a collection
0070: 20 6f 66 20 74 65 73 74 73 20 66 6f 72 20 6f 6e of tests for on
0080: 65 20 6f 72 20 6d 6f 72 65 20 6f 66 20 74 68 65 e or more of the
0090: 20 54 63 6c 0a 23 20 62 75 69 6c 74 2d 69 6e 20 Tcl.# built-in
00a0: 63 6f 6d 6d 61 6e 64 73 2e 20 20 53 6f 75 72 63 commands. Sourc
00b0: 69 6e 67 20 74 68 69 73 20 66 69 6c 65 20 69 6e ing this file in
00c0: 74 6f 20 54 63 6c 20 72 75 6e 73 20 74 68 65 20 to Tcl runs the
00d0: 74 65 73 74 73 20 61 6e 64 0a 23 20 67 65 6e 65 tests and.# gene
00e0: 72 61 74 65 73 20 6f 75 74 70 75 74 20 66 6f 72 rates output for
00f0: 20 65 72 72 6f 72 73 2e 20 20 4e 6f 20 6f 75 74 errors. No out
0100: 70 75 74 20 6d 65 61 6e 73 20 6e 6f 20 65 72 72 put means no err
0110: 6f 72 73 20 77 65 72 65 20 66 6f 75 6e 64 2e 0a ors were found..
0120: 23 0a 23 20 43 6f 70 79 72 69 67 68 74 20 28 63 #.# Copyright (c
0130: 29 20 31 39 39 34 2d 31 39 39 36 20 53 75 6e 20 ) 1994-1996 Sun
0140: 4d 69 63 72 6f 73 79 73 74 65 6d 73 2c 20 49 6e Microsystems, In
0150: 63 2e 0a 23 20 43 6f 70 79 72 69 67 68 74 20 28 c..# Copyright (
0160: 63 29 20 31 39 39 38 2d 32 30 30 30 20 41 6a 75 c) 1998-2000 Aju
0170: 62 61 20 53 6f 6c 75 74 69 6f 6e 73 2e 0a 23 0a ba Solutions..#.
0180: 23 20 53 65 65 20 74 68 65 20 66 69 6c 65 20 22 # See the file "
0190: 6c 69 63 65 6e 73 65 2e 74 65 72 6d 73 22 20 66 license.terms" f
01a0: 6f 72 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f or information o
01b0: 6e 20 75 73 61 67 65 20 61 6e 64 20 72 65 64 69 n usage and redi
01c0: 73 74 72 69 62 75 74 69 6f 6e 0a 23 20 6f 66 20 stribution.# of
01d0: 74 68 69 73 20 66 69 6c 65 2c 20 61 6e 64 20 66 this file, and f
01e0: 6f 72 20 61 20 44 49 53 43 4c 41 49 4d 45 52 20 or a DISCLAIMER
01f0: 4f 46 20 41 4c 4c 20 57 41 52 52 41 4e 54 49 45 OF ALL WARRANTIE
0200: 53 2e 0a 23 0a 0a 23 20 52 75 6e 6e 69 6e 67 20 S..#..# Running
0210: 73 6f 63 6b 65 74 20 74 65 73 74 73 20 77 69 74 socket tests wit
0220: 68 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 h a remote serve
0230: 72 3a 0a 23 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d r:.# -----------
0240: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0250: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a ---------------.
0260: 23 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 20 69 #.# Some tests i
0270: 6e 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 64 65 n socket.test de
0280: 70 65 6e 64 20 6f 6e 20 74 68 65 20 65 78 69 73 pend on the exis
0290: 74 65 6e 63 65 20 6f 66 20 61 20 72 65 6d 6f 74 tence of a remot
02a0: 65 20 73 65 72 76 65 72 20 74 6f 0a 23 20 77 68 e server to.# wh
02b0: 69 63 68 20 74 68 65 79 20 63 6f 6e 6e 65 63 74 ich they connect
02c0: 2e 20 54 68 65 20 72 65 6d 6f 74 65 20 73 65 72 . The remote ser
02d0: 76 65 72 20 6d 75 73 74 20 62 65 20 61 6e 20 69 ver must be an i
02e0: 6e 73 74 61 6e 63 65 20 6f 66 20 74 63 6c 74 65 nstance of tclte
02f0: 73 74 20 61 6e 64 20 69 74 0a 23 20 6d 75 73 74 st and it.# must
0300: 20 72 75 6e 20 74 68 65 20 73 63 72 69 70 74 20 run the script
0310: 66 6f 75 6e 64 20 69 6e 20 74 68 65 20 66 69 6c found in the fil
0320: 65 20 22 72 65 6d 6f 74 65 2e 74 63 6c 22 20 69 e "remote.tcl" i
0330: 6e 20 74 68 69 73 20 64 69 72 65 63 74 6f 72 79 n this directory
0340: 2e 20 59 6f 75 0a 23 20 63 61 6e 20 73 74 61 72 . You.# can star
0350: 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 t the remote ser
0360: 76 65 72 20 6f 6e 20 61 6e 79 20 6d 61 63 68 69 ver on any machi
0370: 6e 65 20 72 65 61 63 68 61 62 6c 65 20 66 72 6f ne reachable fro
0380: 6d 20 74 68 65 20 6d 61 63 68 69 6e 65 20 6f 6e m the machine on
0390: 0a 23 20 77 68 69 63 68 20 79 6f 75 20 77 61 6e .# which you wan
03a0: 74 20 74 6f 20 72 75 6e 20 74 68 65 20 73 6f 63 t to run the soc
03b0: 6b 65 74 20 74 65 73 74 73 2c 20 62 79 20 69 73 ket tests, by is
03c0: 73 75 69 6e 67 3a 0a 23 0a 23 20 20 20 20 20 74 suing:.#.# t
03d0: 63 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 cltest remote.tc
03e0: 6c 20 2d 70 6f 72 74 20 38 30 34 38 09 23 20 4f l -port 8048.# O
03f0: 72 20 63 68 6f 6f 73 65 20 61 6e 6f 74 68 65 72 r choose another
0400: 20 70 6f 72 74 20 6e 75 6d 62 65 72 2e 0a 23 0a port number..#.
0410: 23 20 49 66 20 74 68 65 20 6d 61 63 68 69 6e 65 # If the machine
0420: 20 79 6f 75 20 61 72 65 20 72 75 6e 6e 69 6e 67 you are running
0430: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
0440: 65 72 20 6f 6e 20 68 61 73 20 73 65 76 65 72 61 er on has severa
0450: 6c 20 49 50 0a 23 20 69 6e 74 65 72 66 61 63 65 l IP.# interface
0460: 73 2c 20 79 6f 75 20 63 61 6e 20 63 68 6f 6f 73 s, you can choos
0470: 65 20 77 68 69 63 68 20 69 6e 74 65 72 66 61 63 e which interfac
0480: 65 20 74 68 65 20 73 65 72 76 65 72 20 6c 69 73 e the server lis
0490: 74 65 6e 73 20 6f 6e 20 66 6f 72 0a 23 20 63 6f tens on for.# co
04a0: 6e 6e 65 63 74 69 6f 6e 73 20 62 79 20 73 70 65 nnections by spe
04b0: 63 69 66 79 69 6e 67 20 74 68 65 20 2d 61 64 64 cifying the -add
04c0: 72 65 73 73 20 63 6f 6d 6d 61 6e 64 20 6c 69 6e ress command lin
04d0: 65 20 66 6c 61 67 2c 20 73 6f 3a 0a 23 0a 23 20 e flag, so:.#.#
04e0: 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 6d 6f tcltest remo
04f0: 74 65 2e 74 63 6c 20 2d 61 64 64 72 65 73 73 20 te.tcl -address
0500: 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d your.machine.com
0510: 0a 23 0a 23 20 54 68 65 73 65 20 6f 70 74 69 6f .#.# These optio
0520: 6e 73 20 63 61 6e 20 61 6c 73 6f 20 62 65 20 73 ns can also be s
0530: 65 74 20 62 79 20 65 6e 76 69 72 6f 6e 6d 65 6e et by environmen
0540: 74 20 76 61 72 69 61 62 6c 65 73 2e 20 4f 6e 20 t variables. On
0550: 55 6e 69 78 2c 20 79 6f 75 20 63 61 6e 0a 23 20 Unix, you can.#
0560: 74 79 70 65 20 74 68 65 73 65 20 63 6f 6d 6d 61 type these comma
0570: 6e 64 73 20 74 6f 20 74 68 65 20 73 68 65 6c 6c nds to the shell
0580: 20 66 72 6f 6d 20 77 68 69 63 68 20 74 68 65 20 from which the
0590: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 69 73 remote server is
05a0: 20 73 74 61 72 74 65 64 3a 0a 23 0a 23 20 20 20 started:.#.#
05b0: 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 shell% setenv
05c0: 73 65 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a serverPort 8048.
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 41 64 64 72 65 73 env serverAddres
05f0: 73 20 79 6f 75 72 2e 6d 61 63 68 69 6e 65 2e 63 s your.machine.c
0600: 6f 6d 0a 23 0a 23 20 61 6e 64 20 73 75 62 73 65 om.#.# and subse
0610: 71 75 65 6e 74 6c 79 20 79 6f 75 20 63 61 6e 20 quently you can
0620: 73 74 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 start the remote
0630: 20 73 65 72 76 65 72 20 77 69 74 68 3a 0a 23 0a server with:.#.
0640: 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 65 # tcltest re
0650: 6d 6f 74 65 2e 74 63 6c 0a 23 0a 23 20 74 6f 20 mote.tcl.#.# to
0660: 68 61 76 65 20 69 74 20 6c 69 73 74 65 6e 20 6f have it listen o
0670: 6e 20 70 6f 72 74 20 38 30 34 38 20 6f 6e 20 74 n port 8048 on t
0680: 68 65 20 69 6e 74 65 72 66 61 63 65 20 79 6f 75 he interface you
0690: 72 2e 6d 61 63 68 69 6e 65 2e 63 6f 6d 2e 0a 23 r.machine.com..#
06a0: 0a 23 20 57 68 65 6e 20 74 68 65 20 73 65 72 76 .# When the serv
06b0: 65 72 20 73 74 61 72 74 73 2c 20 69 74 20 70 72 er starts, it pr
06c0: 69 6e 74 73 20 6f 75 74 20 61 20 64 65 74 61 69 ints out a detai
06d0: 6c 65 64 20 6d 65 73 73 61 67 65 20 63 6f 6e 74 led message cont
06e0: 61 69 6e 69 6e 67 20 69 74 73 0a 23 20 63 6f 6e aining its.# con
06f0: 66 69 67 75 72 61 74 69 6f 6e 20 69 6e 66 6f 72 figuration infor
0700: 6d 61 74 69 6f 6e 2c 20 61 6e 64 20 69 74 20 77 mation, and it w
0710: 69 6c 6c 20 62 6c 6f 63 6b 20 75 6e 74 69 6c 20 ill block until
0720: 6b 69 6c 6c 65 64 20 77 69 74 68 20 61 20 43 74 killed with a Ct
0730: 72 6c 2d 43 2e 0a 23 20 4f 6e 63 65 20 74 68 65 rl-C..# Once the
0740: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 65 remote server e
0750: 78 69 73 74 73 2c 20 79 6f 75 20 63 61 6e 20 72 xists, you can r
0760: 75 6e 20 74 68 65 20 74 65 73 74 73 20 69 6e 20 un the tests in
0770: 73 6f 63 6b 65 74 2e 74 65 73 74 20 77 69 74 68 socket.test with
0780: 0a 23 20 74 68 65 20 73 65 72 76 65 72 20 62 79 .# the server by
0790: 20 73 65 74 74 69 6e 67 20 74 77 6f 20 54 63 6c setting two Tcl
07a0: 20 76 61 72 69 61 62 6c 65 73 3a 0a 23 0a 23 20 variables:.#.#
07b0: 20 20 20 20 25 20 73 65 74 20 72 65 6d 6f 74 65 % set remote
07c0: 53 65 72 76 65 72 49 50 20 3c 6e 61 6d 65 20 6f ServerIP <name o
07d0: 72 20 61 64 64 72 65 73 73 20 6f 66 20 6d 61 63 r address of mac
07e0: 68 69 6e 65 20 6f 6e 20 77 68 69 63 68 20 73 65 hine on which se
07f0: 72 76 65 72 20 72 75 6e 73 3e 0a 23 20 20 20 20 rver runs>.#
0800: 20 25 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 % set remoteSer
0810: 76 65 72 50 6f 72 74 20 38 30 34 38 0a 23 0a 23 verPort 8048.#.#
0820: 20 54 68 65 73 65 20 76 61 72 69 61 62 6c 65 73 These variables
0830: 20 61 72 65 20 61 6c 73 6f 20 73 65 74 74 61 62 are also settab
0840: 6c 65 20 66 72 6f 6d 20 74 68 65 20 65 6e 76 69 le from the envi
0850: 72 6f 6e 6d 65 6e 74 2e 20 4f 6e 20 55 6e 69 78 ronment. On Unix
0860: 2c 20 79 6f 75 20 63 61 6e 3a 0a 23 0a 23 20 20 , you can:.#.#
0870: 20 20 20 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 shell% setenv
0880: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 remoteServerIP
0890: 6d 61 63 68 69 6e 65 2e 77 68 65 72 65 2e 73 65 machine.where.se
08a0: 72 76 65 72 2e 72 75 6e 73 0a 23 20 20 20 20 20 rver.runs.#
08b0: 73 68 65 6c 6c 25 20 73 65 74 65 6e 76 20 72 65 shell% setenv re
08c0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 38 moteServerPort 8
08d0: 30 34 38 0a 23 0a 23 20 54 68 65 20 70 72 65 61 048.#.# The prea
08e0: 6d 62 6c 65 20 6f 66 20 74 68 65 20 73 6f 63 6b mble of the sock
08f0: 65 74 2e 74 65 73 74 20 66 69 6c 65 20 63 68 65 et.test file che
0900: 63 6b 73 20 74 6f 20 73 65 65 20 69 66 20 74 68 cks to see if th
0910: 65 20 76 61 72 69 61 62 6c 65 73 20 61 72 65 20 e variables are
0920: 73 65 74 0a 23 20 65 69 74 68 65 72 20 69 6e 20 set.# either in
0930: 54 63 6c 20 6f 72 20 69 6e 20 74 68 65 20 65 6e Tcl or in the en
0940: 76 69 72 6f 6e 6d 65 6e 74 3b 20 69 66 20 74 68 vironment; if th
0950: 65 79 20 61 72 65 2c 20 69 74 20 61 74 74 65 6d ey are, it attem
0960: 70 74 73 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 pts to connect t
0970: 6f 0a 23 20 74 68 65 20 73 65 72 76 65 72 2e 20 o.# the server.
0980: 49 66 20 74 68 65 20 63 6f 6e 6e 65 63 74 69 6f If the connectio
0990: 6e 20 69 73 20 73 75 63 63 65 73 73 66 75 6c 2c n is successful,
09a0: 20 74 68 65 20 74 65 73 74 73 20 75 73 69 6e 67 the tests using
09b0: 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 20 73 65 the remote.# se
09c0: 72 76 65 72 20 77 69 6c 6c 20 62 65 20 70 65 72 rver will be per
09d0: 66 6f 72 6d 65 64 3b 20 6f 74 68 65 72 77 69 73 formed; otherwis
09e0: 65 2c 20 69 74 20 77 69 6c 6c 20 61 74 74 65 6d e, it will attem
09f0: 70 74 20 74 6f 20 73 74 61 72 74 20 74 68 65 20 pt to start the
0a00: 72 65 6d 6f 74 65 0a 23 20 73 65 72 76 65 72 20 remote.# server
0a10: 28 76 69 61 20 65 78 65 63 29 20 6f 6e 20 70 6c (via exec) on pl
0a20: 61 74 66 6f 72 6d 73 20 74 68 61 74 20 73 75 70 atforms that sup
0a30: 70 6f 72 74 20 74 68 69 73 2c 20 6f 6e 20 74 68 port this, on th
0a40: 65 20 6c 6f 63 61 6c 20 68 6f 73 74 2c 0a 23 20 e local host,.#
0a50: 6c 69 73 74 65 6e 69 6e 67 20 61 74 20 70 6f 72 listening at por
0a60: 74 20 38 30 34 38 2e 20 49 66 20 61 6c 6c 20 66 t 8048. If all f
0a70: 61 69 6c 73 2c 20 61 20 6d 65 73 73 61 67 65 20 ails, a message
0a80: 69 73 20 70 72 69 6e 74 65 64 20 61 6e 64 20 74 is printed and t
0a90: 68 65 20 74 65 73 74 73 0a 23 20 75 73 69 6e 67 he tests.# using
0aa0: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
0ab0: 65 72 20 61 72 65 20 6e 6f 74 20 70 65 72 66 6f er are not perfo
0ac0: 72 6d 65 64 2e 0a 0a 70 72 6f 63 20 64 70 75 74 rmed...proc dput
0ad0: 73 20 7b 6d 73 67 7d 20 7b 20 72 65 74 75 72 6e s {msg} { return
0ae0: 20 3b 20 70 75 74 73 20 73 74 64 65 72 72 20 24 ; puts stderr $
0af0: 6d 73 67 20 3b 20 66 6c 75 73 68 20 73 74 64 65 msg ; flush stde
0b00: 72 72 20 7d 0a 0a 69 66 20 7b 5b 6c 73 65 61 72 rr }..if {[lsear
0b10: 63 68 20 5b 6e 61 6d 65 73 70 61 63 65 20 63 68 ch [namespace ch
0b20: 69 6c 64 72 65 6e 5d 20 3a 3a 74 63 6c 74 65 73 ildren] ::tcltes
0b30: 74 5d 20 3d 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 t] == -1} {.
0b40: 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 package require
0b50: 74 63 6c 74 65 73 74 0a 20 20 20 20 6e 61 6d 65 tcltest. name
0b60: 73 70 61 63 65 20 69 6d 70 6f 72 74 20 2d 66 6f space import -fo
0b70: 72 63 65 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 2a rce ::tcltest::*
0b80: 0a 7d 0a 0a 23 20 54 68 65 20 62 75 69 6c 64 20 .}..# The build
0b90: 64 69 72 20 69 73 20 61 64 64 65 64 20 61 73 20 dir is added as
0ba0: 74 68 65 20 66 69 72 73 74 20 65 6c 65 6d 65 6e the first elemen
0bb0: 74 20 6f 66 20 24 50 41 54 48 0a 23 20 4c 6f 61 t of $PATH.# Loa
0bc0: 64 20 74 68 65 20 74 6c 73 20 70 61 63 6b 61 67 d the tls packag
0bd0: 65 0a 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 e.package requir
0be0: 65 20 74 6c 73 0a 0a 73 65 74 20 74 6c 73 53 65 e tls..set tlsSe
0bf0: 72 76 65 72 50 6f 72 74 20 38 30 34 38 0a 0a 23 rverPort 8048..#
0c00: 20 53 70 65 63 69 66 79 20 77 68 65 72 65 20 74 Specify where t
0c10: 68 65 20 63 65 72 74 69 66 69 63 61 74 65 73 20 he certificates
0c20: 61 72 65 0a 0a 73 65 74 20 63 65 72 74 73 44 69 are..set certsDi
0c30: 72 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 r.[file join [fi
0c40: 6c 65 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f le dirname [info
0c50: 20 73 63 72 69 70 74 5d 5d 20 63 65 72 74 73 5d script]] certs]
0c60: 0a 73 65 74 20 73 65 72 76 65 72 43 65 72 74 09 .set serverCert.
0c70: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
0c80: 73 44 69 72 20 73 65 72 76 65 72 2e 70 65 6d 5d sDir server.pem]
0c90: 0a 73 65 74 20 63 6c 69 65 6e 74 43 65 72 74 09 .set clientCert.
0ca0: 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 [file join $cert
0cb0: 73 44 69 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d sDir client.pem]
0cc0: 0a 73 65 74 20 63 61 43 65 72 74 09 5b 66 69 6c .set caCert.[fil
0cd0: 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 e join $certsDir
0ce0: 20 63 61 2e 70 65 6d 5d 0a 73 65 74 20 73 65 72 ca.pem].set ser
0cf0: 76 65 72 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 verKey.[file joi
0d00: 6e 20 24 63 65 72 74 73 44 69 72 20 73 65 72 76 n $certsDir serv
0d10: 65 72 2e 6b 65 79 5d 0a 73 65 74 20 63 6c 69 65 er.key].set clie
0d20: 6e 74 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e ntKey.[file join
0d30: 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 6e $certsDir clien
0d40: 74 2e 6b 65 79 5d 0a 0a 23 20 53 6f 6d 65 20 74 t.key]..# Some t
0d50: 65 73 74 73 20 72 65 71 75 69 72 65 20 74 68 65 ests require the
0d60: 20 74 65 73 74 74 68 72 65 61 64 20 61 6e 64 20 testthread and
0d70: 65 78 65 63 20 63 6f 6d 6d 61 6e 64 73 0a 0a 73 exec commands..s
0d80: 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 et ::tcltest::te
0d90: 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 74 65 stConstraints(te
0da0: 73 74 74 68 72 65 61 64 29 20 5c 0a 09 5b 65 78 stthread) \..[ex
0db0: 70 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e pr {[info comman
0dc0: 64 73 20 74 65 73 74 74 68 72 65 61 64 5d 20 6e ds testthread] n
0dd0: 65 20 7b 7d 7d 5d 0a 73 65 74 20 3a 3a 74 63 6c e {}}].set ::tcl
0de0: 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 test::testConstr
0df0: 61 69 6e 74 73 28 65 78 65 63 29 20 5b 65 78 70 aints(exec) [exp
0e00: 72 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 r {[info command
0e10: 73 20 65 78 65 63 5d 20 6e 65 20 7b 7d 7d 5d 0a s exec] ne {}}].
0e20: 0a 23 0a 23 20 49 66 20 72 65 6d 6f 74 65 53 65 .#.# If remoteSe
0e30: 72 76 65 72 49 50 20 6f 72 20 72 65 6d 6f 74 65 rverIP or remote
0e40: 53 65 72 76 65 72 50 6f 72 74 20 61 72 65 20 6e ServerPort are n
0e50: 6f 74 20 73 65 74 2c 20 63 68 65 63 6b 20 69 6e ot set, check in
0e60: 20 74 68 65 0a 23 20 65 6e 76 69 72 6f 6e 6d 65 the.# environme
0e70: 6e 74 20 76 61 72 69 61 62 6c 65 73 20 66 6f 72 nt variables for
0e80: 20 65 78 74 65 72 6e 61 6c 6c 79 20 73 65 74 20 externally set
0e90: 76 61 6c 75 65 73 2e 0a 23 0a 0a 69 66 20 7b 21 values..#..if {!
0ea0: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 65 6d [info exists rem
0eb0: 6f 74 65 53 65 72 76 65 72 49 50 5d 7d 20 7b 0a oteServerIP]} {.
0ec0: 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 if {[info ex
0ed0: 69 73 74 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 ists env(remoteS
0ee0: 65 72 76 65 72 49 50 29 5d 7d 20 7b 0a 09 73 65 erverIP)]} {..se
0ef0: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 t remoteServerIP
0f00: 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 $env(remoteServ
0f10: 65 72 49 50 29 0a 20 20 20 20 7d 0a 7d 0a 69 66 erIP). }.}.if
0f20: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
0f30: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
0f40: 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e ]} {. if {[in
0f50: 66 6f 20 65 78 69 73 74 73 20 65 6e 76 28 72 65 fo exists env(re
0f60: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 5d moteServerPort)]
0f70: 7d 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 53 } {..set remoteS
0f80: 65 72 76 65 72 50 6f 72 74 20 24 65 6e 76 28 72 erverPort $env(r
0f90: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 29 emoteServerPort)
0fa0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
0fb0: 20 20 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 if {[info
0fc0: 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 exists remoteSer
0fd0: 76 65 72 49 50 5d 7d 20 7b 0a 09 20 20 20 20 73 verIP]} {.. s
0fe0: 65 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 et remoteServerP
0ff0: 6f 72 74 20 24 74 6c 73 53 65 72 76 65 72 50 6f ort $tlsServerPo
1000: 72 74 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 rt. }.
1010: 20 7d 0a 7d 0a 0a 70 72 6f 63 20 64 6f 5f 68 61 }.}..proc do_ha
1020: 6e 64 73 68 61 6b 65 20 7b 73 20 7b 74 79 70 65 ndshake {s {type
1030: 20 72 65 61 64 61 62 6c 65 7d 20 7b 63 6d 64 20 readable} {cmd
1040: 7b 7d 7d 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 {}} args} {.
1050: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
1060: 09 63 6c 6f 73 65 20 24 73 0a 09 64 70 75 74 73 .close $s..dputs
1070: 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 65 6f 66 "handshake: eof
1080: 22 0a 09 73 65 74 20 3a 3a 64 6f 5f 68 61 6e 64 "..set ::do_hand
1090: 73 68 61 6b 65 20 22 65 6f 66 22 0a 20 20 20 20 shake "eof".
10a0: 7d 20 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 } elseif {[catch
10b0: 20 7b 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 {tls::handshake
10c0: 20 24 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a $s} result]} {.
10d0: 09 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 .# Some errors a
10e0: 72 65 20 6e 6f 72 6d 61 6c 2e 0a 09 64 70 75 74 re normal...dput
10f0: 73 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 24 72 s "handshake: $r
1100: 65 73 75 6c 74 22 0a 20 20 20 20 7d 20 65 6c 73 esult". } els
1110: 65 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 eif {$result ==
1120: 31 7d 20 7b 0a 09 23 20 48 61 6e 64 73 68 61 6b 1} {..# Handshak
1130: 65 20 63 6f 6d 70 6c 65 74 65 0a 09 69 66 20 7b e complete..if {
1140: 5b 6c 6c 65 6e 67 74 68 20 24 61 72 67 73 5d 7d [llength $args]}
1150: 20 7b 20 65 76 61 6c 20 5b 6c 69 73 74 20 66 63 { eval [list fc
1160: 6f 6e 66 69 67 75 72 65 20 24 73 5d 20 24 61 72 onfigure $s] $ar
1170: 67 73 20 7d 0a 09 69 66 20 7b 24 63 6d 64 20 65 gs }..if {$cmd e
1180: 71 20 22 22 7d 20 7b 0a 09 20 20 20 20 66 69 6c q ""} {.. fil
1190: 65 65 76 65 6e 74 20 24 73 20 24 74 79 70 65 20 eevent $s $type
11a0: 22 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 ""..} else {..
11b0: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 24 fileevent $s $
11c0: 74 79 70 65 20 22 24 63 6d 64 20 5b 6c 69 73 74 type "$cmd [list
11d0: 20 24 73 5d 22 0a 09 7d 0a 09 64 70 75 74 73 20 $s]"..}..dputs
11e0: 22 68 61 6e 64 73 68 61 6b 65 3a 20 63 6f 6d 70 "handshake: comp
11f0: 6c 65 74 65 22 0a 09 73 65 74 20 3a 3a 64 6f 5f lete"..set ::do_
1200: 68 61 6e 64 73 68 61 6b 65 20 22 63 6f 6d 70 6c handshake "compl
1210: 65 74 65 22 0a 20 20 20 20 7d 20 65 6c 73 65 20 ete". } else
1220: 7b 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 {..dputs "handsh
1230: 61 6b 65 3a 20 69 6e 20 70 72 6f 67 72 65 73 73 ake: in progress
1240: 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 20 43 ". }.}..#.# C
1250: 68 65 63 6b 20 69 66 20 77 65 27 72 65 20 73 75 heck if we're su
1260: 70 70 6f 73 65 64 20 74 6f 20 64 6f 20 74 65 73 pposed to do tes
1270: 74 73 20 61 67 61 69 6e 73 74 20 74 68 65 20 72 ts against the r
1280: 65 6d 6f 74 65 20 73 65 72 76 65 72 0a 23 0a 0a emote server.#..
1290: 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 set doTestsWithR
12a0: 65 6d 6f 74 65 53 65 72 76 65 72 20 31 0a 69 66 emoteServer 1.if
12b0: 20 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 {![info exists
12c0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 20 remoteServerIP]
12d0: 26 26 20 28 24 74 63 6c 5f 70 6c 61 74 66 6f 72 && ($tcl_platfor
12e0: 6d 28 70 6c 61 74 66 6f 72 6d 29 20 6e 65 20 22 m(platform) ne "
12f0: 6d 61 63 69 6e 74 6f 73 68 22 29 7d 20 7b 0a 20 macintosh")} {.
1300: 20 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 set remoteSer
1310: 76 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a verIP 127.0.0.1.
1320: 7d 0a 69 66 20 7b 28 24 64 6f 54 65 73 74 73 57 }.if {($doTestsW
1330: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
1340: 3d 3d 20 31 29 20 26 26 20 28 21 5b 69 6e 66 6f == 1) && (![info
1350: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 exists remoteSe
1360: 72 76 65 72 50 6f 72 74 5d 29 7d 20 7b 0a 20 20 rverPort])} {.
1370: 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 set remoteServ
1380: 65 72 50 6f 72 74 20 24 74 6c 73 53 65 72 76 65 erPort $tlsServe
1390: 72 50 6f 72 74 0a 7d 0a 0a 23 20 41 74 74 65 6d rPort.}..# Attem
13a0: 70 74 20 74 6f 20 63 6f 6e 6e 65 63 74 20 74 6f pt to connect to
13b0: 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 a remote server
13c0: 20 69 66 20 6f 6e 65 20 69 73 20 61 6c 72 65 61 if one is alrea
13d0: 64 79 20 72 75 6e 6e 69 6e 67 2e 20 49 66 20 69 dy running. If i
13e0: 74 0a 23 20 69 73 20 6e 6f 74 20 72 75 6e 6e 69 t.# is not runni
13f0: 6e 67 20 6f 72 20 66 6f 72 20 73 6f 6d 65 20 6f ng or for some o
1400: 74 68 65 72 20 72 65 61 73 6f 6e 20 74 68 65 20 ther reason the
1410: 63 6f 6e 6e 65 63 74 20 66 61 69 6c 73 2c 20 61 connect fails, a
1420: 74 74 65 6d 70 74 20 74 6f 0a 23 20 73 74 61 72 ttempt to.# star
1430: 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 t the remote ser
1440: 76 65 72 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c ver on the local
1450: 20 68 6f 73 74 20 6c 69 73 74 65 6e 69 6e 67 20 host listening
1460: 6f 6e 20 70 6f 72 74 20 38 30 34 38 2e 20 54 68 on port 8048. Th
1470: 69 73 0a 23 20 69 73 20 6f 6e 6c 79 20 64 6f 6e is.# is only don
1480: 65 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 74 e on platforms t
1490: 68 61 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 hat support exec
14a0: 20 28 69 2e 65 2e 20 6e 6f 74 20 6f 6e 20 74 68 (i.e. not on th
14b0: 65 20 4d 61 63 29 2e 20 4f 6e 0a 23 20 70 6c 61 e Mac). On.# pla
14c0: 74 66 6f 72 6d 73 20 74 68 61 74 20 64 6f 20 6e tforms that do n
14d0: 6f 74 20 73 75 70 70 6f 72 74 20 65 78 65 63 2c ot support exec,
14e0: 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 72 76 the remote serv
14f0: 65 72 20 6d 75 73 74 20 62 65 20 73 74 61 72 74 er must be start
1500: 65 64 0a 23 20 62 79 20 74 68 65 20 75 73 65 72 ed.# by the user
1510: 20 62 65 66 6f 72 65 20 72 75 6e 6e 69 6e 67 20 before running
1520: 74 68 65 20 74 65 73 74 73 2e 0a 0a 73 65 74 20 the tests...set
1530: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 20 22 remoteProcChan "
1540: 22 0a 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 ".set commandSoc
1550: 6b 65 74 20 22 22 0a 69 66 20 7b 24 64 6f 54 65 ket "".if {$doTe
1560: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
1570: 76 65 72 7d 20 7b 0a 20 20 20 20 63 61 74 63 68 ver} {. catch
1580: 20 7b 63 6c 6f 73 65 20 24 63 6f 6d 6d 61 6e 64 {close $command
1590: 53 6f 63 6b 65 74 7d 0a 20 20 20 20 69 66 20 7b Socket}. if {
15a0: 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f 6d 6d [catch {set comm
15b0: 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 3a 3a andSocket [tls::
15c0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
15d0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
15e0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
15f0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
1600: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
1610: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 remoteServerIP $
1620: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
1630: 5d 7d 5d 20 21 3d 20 30 7d 20 7b 0a 09 69 66 20 ]}] != 0} {..if
1640: 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 73 20 {[info commands
1650: 65 78 65 63 5d 20 65 71 20 22 22 7d 20 7b 0a 09 exec] eq ""} {..
1660: 20 20 20 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 set noRemote
1670: 54 65 73 74 52 65 61 73 6f 6e 20 22 63 61 6e 27 TestReason "can'
1680: 74 20 65 78 65 63 22 0a 09 20 20 20 20 73 65 74 t exec".. set
1690: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
16a0: 74 65 53 65 72 76 65 72 20 30 0a 09 7d 20 65 6c teServer 0..} el
16b0: 73 65 20 7b 0a 09 20 20 20 20 73 65 74 20 72 65 se {.. set re
16c0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 37 moteServerIP 127
16d0: 2e 30 2e 30 2e 31 0a 09 20 20 20 20 73 65 74 20 .0.0.1.. set
16e0: 72 65 6d 6f 74 65 46 69 6c 65 20 5b 66 69 6c 65 remoteFile [file
16f0: 20 6a 6f 69 6e 20 5b 70 77 64 5d 20 72 65 6d 6f join [pwd] remo
1700: 74 65 2e 74 63 6c 5d 0a 09 20 20 20 20 69 66 20 te.tcl].. if
1710: 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 72 65 6d {[catch {set rem
1720: 6f 74 65 50 72 6f 63 43 68 61 6e 20 5c 0a 09 09 oteProcChan \...
1730: 20 20 20 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 [open "|[lis
1740: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
1750: 6c 74 65 73 74 20 24 72 65 6d 6f 74 65 46 69 6c ltest $remoteFil
1760: 65 20 5c 0a 09 09 20 20 20 20 2d 73 65 72 76 65 e \... -serve
1770: 72 49 73 53 69 6c 65 6e 74 20 2d 70 6f 72 74 20 rIsSilent -port
1780: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 $remoteServerPor
1790: 74 20 5c 0a 09 09 20 20 20 20 2d 61 64 64 72 65 t \... -addre
17a0: 73 73 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 ss $remoteServer
17b0: 49 50 5d 22 20 77 2b 5d 7d 20 6d 73 67 5d 20 3d IP]" w+]} msg] =
17c0: 3d 20 30 7d 20 7b 0a 09 09 61 66 74 65 72 20 31 = 0} {...after 1
17d0: 30 30 30 0a 09 09 69 66 20 7b 5b 63 61 74 63 68 000...if {[catch
17e0: 20 7b 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 {set commandSoc
17f0: 6b 65 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ket [tls::socket
1800: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
1810: 20 5c 0a 09 09 09 2d 63 65 72 74 66 69 6c 65 20 \....-certfile
1820: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 6b 65 79 $clientCert -key
1830: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
1840: 5c 0a 09 09 09 24 72 65 6d 6f 74 65 53 65 72 76 \....$remoteServ
1850: 65 72 49 50 20 24 72 65 6d 6f 74 65 53 65 72 76 erIP $remoteServ
1860: 65 72 50 6f 72 74 5d 7d 20 6d 73 67 5d 20 3d 3d erPort]} msg] ==
1870: 20 30 7d 20 7b 0a 09 09 20 20 20 20 66 63 6f 6e 0} {... fcon
1880: 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 6e 64 53 figure $commandS
1890: 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c 61 74 69 ocket -translati
18a0: 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 on crlf -bufferi
18b0: 6e 67 20 6c 69 6e 65 0a 09 09 7d 20 65 6c 73 65 ng line...} else
18c0: 20 7b 0a 09 09 20 20 20 20 73 65 74 20 6e 6f 52 {... set noR
18d0: 65 6d 6f 74 65 54 65 73 74 52 65 61 73 6f 6e 20 emoteTestReason
18e0: 24 6d 73 67 0a 09 09 20 20 20 20 73 65 74 20 64 $msg... set d
18f0: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
1900: 53 65 72 76 65 72 20 30 0a 09 09 7d 0a 09 20 20 Server 0...}..
1910: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 73 65 74 } else {...set
1920: 20 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 noRemoteTestRea
1930: 73 6f 6e 20 22 24 6d 73 67 20 24 3a 3a 74 63 6c son "$msg $::tcl
1940: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 22 0a 09 test::tcltest"..
1950: 09 73 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 .set doTestsWith
1960: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 0a 09 RemoteServer 0..
1970: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 20 65 }..}. } e
1980: 6c 73 65 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 lse {..fconfigur
1990: 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 e $commandSocket
19a0: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 -translation cr
19b0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
19c0: 6e 65 0a 20 20 20 20 7d 0a 7d 0a 0a 23 20 53 6f ne. }.}..# So
19d0: 6d 65 20 74 65 73 74 73 20 61 72 65 20 72 75 6e me tests are run
19e0: 20 6f 6e 6c 79 20 69 66 20 77 65 20 61 72 65 20 only if we are
19f0: 64 6f 69 6e 67 20 74 65 73 74 69 6e 67 20 61 67 doing testing ag
1a00: 61 69 6e 73 74 20 61 20 72 65 6d 6f 74 65 20 73 ainst a remote s
1a10: 65 72 76 65 72 2e 0a 73 65 74 20 3a 3a 74 63 6c erver..set ::tcl
1a20: 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 test::testConstr
1a30: 61 69 6e 74 73 28 64 6f 54 65 73 74 73 57 69 74 aints(doTestsWit
1a40: 68 52 65 6d 6f 74 65 53 65 72 76 65 72 29 20 24 hRemoteServer) $
1a50: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1a60: 65 53 65 72 76 65 72 0a 69 66 20 7b 24 64 6f 54 eServer.if {$doT
1a70: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
1a80: 72 76 65 72 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 rver == 0} {.
1a90: 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 if {[string fir
1aa0: 73 74 20 73 20 24 3a 3a 74 63 6c 74 65 73 74 3a st s $::tcltest:
1ab0: 3a 76 65 72 62 6f 73 65 5d 20 21 3d 20 2d 31 7d :verbose] != -1}
1ac0: 20 7b 0a 20 20 20 20 09 70 75 74 73 20 22 53 6b {. .puts "Sk
1ad0: 69 70 70 69 6e 67 20 74 65 73 74 73 20 77 69 74 ipping tests wit
1ae0: 68 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e h remote server.
1af0: 20 53 65 65 20 74 65 73 74 73 2f 73 6f 63 6b 65 See tests/socke
1b00: 74 2e 74 65 73 74 20 66 6f 72 22 0a 09 70 75 74 t.test for"..put
1b10: 73 20 22 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 6f s "information o
1b20: 6e 20 68 6f 77 20 74 6f 20 72 75 6e 20 72 65 6d n how to run rem
1b30: 6f 74 65 20 73 65 72 76 65 72 2e 22 0a 09 70 75 ote server."..pu
1b40: 74 73 20 22 52 65 61 73 6f 6e 20 66 6f 72 20 6e ts "Reason for n
1b50: 6f 74 20 64 6f 69 6e 67 20 72 65 6d 6f 74 65 20 ot doing remote
1b60: 74 65 73 74 73 3a 20 24 6e 6f 52 65 6d 6f 74 65 tests: $noRemote
1b70: 54 65 73 74 52 65 61 73 6f 6e 22 0a 20 20 20 20 TestReason".
1b80: 7d 0a 7d 0a 0a 23 0a 23 20 49 66 20 77 65 20 64 }.}..#.# If we d
1b90: 6f 20 74 68 65 20 74 65 73 74 73 2c 20 64 65 66 o the tests, def
1ba0: 69 6e 65 20 61 20 63 6f 6d 6d 61 6e 64 20 74 6f ine a command to
1bb0: 20 73 65 6e 64 20 61 20 63 6f 6d 6d 61 6e 64 20 send a command
1bc0: 74 6f 20 74 68 65 0a 23 20 72 65 6d 6f 74 65 20 to the.# remote
1bd0: 73 65 72 76 65 72 2e 0a 23 0a 0a 69 66 20 7b 24 server..#..if {$
1be0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1bf0: 65 53 65 72 76 65 72 20 3d 3d 20 31 7d 20 7b 0a eServer == 1} {.
1c00: 20 20 20 20 70 72 6f 63 20 73 65 6e 64 43 6f 6d proc sendCom
1c10: 6d 61 6e 64 20 7b 63 7d 20 7b 0a 09 67 6c 6f 62 mand {c} {..glob
1c20: 61 6c 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 al commandSocket
1c30: 0a 0a 09 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d ...if {[eof $com
1c40: 6d 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 mandSocket]} {..
1c50: 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 error "remot
1c60: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 e server disappe
1c70: 61 72 65 64 22 0a 09 7d 0a 0a 09 69 66 20 7b 5b ared"..}...if {[
1c80: 63 61 74 63 68 20 7b 70 75 74 73 20 24 63 6f 6d catch {puts $com
1c90: 6d 61 6e 64 53 6f 63 6b 65 74 20 24 63 7d 20 6d mandSocket $c} m
1ca0: 73 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f sg]} {.. erro
1cb0: 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 r "remote server
1cc0: 20 64 69 73 61 70 70 65 61 72 65 64 3a 20 24 6d disappeared: $m
1cd0: 73 67 22 0a 09 7d 0a 09 69 66 20 7b 5b 63 61 74 sg"..}..if {[cat
1ce0: 63 68 20 7b 70 75 74 73 20 24 63 6f 6d 6d 61 6e ch {puts $comman
1cf0: 64 53 6f 63 6b 65 74 20 22 2d 2d 4d 61 72 6b 65 dSocket "--Marke
1d00: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 r--Marker--Marke
1d10: 72 2d 2d 22 7d 20 6d 73 67 5d 7d 20 7b 0a 09 20 r--"} msg]} {..
1d20: 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 error "remote
1d30: 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 61 server disappea
1d40: 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 0a 09 red: $msg"..}...
1d50: 73 65 74 20 72 65 73 70 20 22 22 0a 09 77 68 69 set resp ""..whi
1d60: 6c 65 20 7b 31 7d 20 7b 0a 09 20 20 20 20 73 65 le {1} {.. se
1d70: 74 20 6c 69 6e 65 20 5b 67 65 74 73 20 24 63 6f t line [gets $co
1d80: 6d 6d 61 6e 64 53 6f 63 6b 65 74 5d 0a 09 20 20 mmandSocket]..
1d90: 20 20 69 66 20 7b 5b 65 6f 66 20 24 63 6f 6d 6d if {[eof $comm
1da0: 61 6e 64 53 6f 63 6b 65 74 5d 7d 20 7b 0a 09 09 andSocket]} {...
1db0: 65 72 72 6f 72 20 22 72 65 6d 6f 74 65 20 73 65 error "remote se
1dc0: 72 76 65 72 20 64 69 73 61 70 70 65 61 72 65 64 rver disappeared
1dd0: 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 69 66 ".. }.. if
1de0: 20 7b 24 6c 69 6e 65 20 65 71 20 22 2d 2d 4d 61 {$line eq "--Ma
1df0: 72 6b 65 72 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 rker--Marker--Ma
1e00: 72 6b 65 72 2d 2d 22 7d 20 7b 0a 09 09 69 66 20 rker--"} {...if
1e10: 7b 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 30 {[lindex $resp 0
1e20: 5d 20 65 71 20 22 65 72 72 6f 72 22 7d 20 7b 0a ] eq "error"} {.
1e30: 09 09 20 20 20 20 65 72 72 6f 72 20 5b 6c 69 6e .. error [lin
1e40: 64 65 78 20 24 72 65 73 70 20 31 5d 0a 09 09 7d dex $resp 1]...}
1e50: 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 20 72 65 else {... re
1e60: 74 75 72 6e 20 5b 6c 69 6e 64 65 78 20 24 72 65 turn [lindex $re
1e70: 73 70 20 31 5d 0a 09 09 7d 0a 09 20 20 20 20 7d sp 1]...}.. }
1e80: 20 65 6c 73 65 20 7b 0a 09 09 61 70 70 65 6e 64 else {...append
1e90: 20 72 65 73 70 20 24 6c 69 6e 65 20 22 5c 6e 22 resp $line "\n"
1ea0: 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d .. }..}. }
1eb0: 0a 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e .. sendComman
1ec0: 64 20 5b 6c 69 73 74 20 70 72 6f 63 20 64 70 75 d [list proc dpu
1ed0: 74 73 20 5b 69 6e 66 6f 20 61 72 67 73 20 64 70 ts [info args dp
1ee0: 75 74 73 5d 20 5b 69 6e 66 6f 20 62 6f 64 79 20 uts] [info body
1ef0: 64 70 75 74 73 5d 5d 0a 0a 20 20 20 20 70 72 6f dputs]].. pro
1f00: 63 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 c sendCertValues
1f10: 20 7b 7d 20 7b 0a 09 23 20 57 65 20 6e 65 65 64 {} {..# We need
1f20: 20 74 6f 20 62 65 20 61 62 6c 65 20 74 6f 20 73 to be able to s
1f30: 65 6e 64 20 63 65 72 74 69 66 69 63 61 74 65 20 end certificate
1f40: 76 61 6c 75 65 73 20 74 68 61 74 20 6e 6f 72 6d values that norm
1f50: 61 6c 69 7a 65 0a 09 23 20 66 69 6c 65 6e 61 6d alize..# filenam
1f60: 65 73 20 61 63 72 6f 73 73 20 70 6c 61 74 66 6f es across platfo
1f70: 72 6d 73 0a 09 73 65 6e 64 43 6f 6d 6d 61 6e 64 rms..sendCommand
1f80: 20 7b 0a 09 20 20 20 20 73 65 74 20 63 65 72 74 {.. set cert
1f90: 73 44 69 72 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 sDir.[file join
1fa0: 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 5b 69 [file dirname [i
1fb0: 6e 66 6f 20 73 63 72 69 70 74 5d 5d 20 63 65 72 nfo script]] cer
1fc0: 74 73 5d 0a 09 20 20 20 20 73 65 74 20 73 65 72 ts].. set ser
1fd0: 76 65 72 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f verCert.[file jo
1fe0: 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 65 72 in $certsDir ser
1ff0: 76 65 72 2e 70 65 6d 5d 0a 09 20 20 20 20 73 65 ver.pem].. se
2000: 74 20 63 6c 69 65 6e 74 43 65 72 74 09 5b 66 69 t clientCert.[fi
2010: 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 le join $certsDi
2020: 72 20 63 6c 69 65 6e 74 2e 70 65 6d 5d 0a 09 20 r client.pem]..
2030: 20 20 20 73 65 74 20 63 61 43 65 72 74 09 09 5b set caCert..[
2040: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
2050: 44 69 72 20 63 61 63 65 72 74 2e 70 65 6d 5d 0a Dir cacert.pem].
2060: 09 20 20 20 20 73 65 74 20 73 65 72 76 65 72 4b . set serverK
2070: 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 ey.[file join $c
2080: 65 72 74 73 44 69 72 20 73 65 72 76 65 72 2e 6b ertsDir server.k
2090: 65 79 5d 0a 09 20 20 20 20 73 65 74 20 63 6c 69 ey].. set cli
20a0: 65 6e 74 4b 65 79 09 5b 66 69 6c 65 20 6a 6f 69 entKey.[file joi
20b0: 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 65 n $certsDir clie
20c0: 6e 74 2e 6b 65 79 5d 0a 09 7d 0a 20 20 20 20 7d nt.key]..}. }
20d0: 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 .}..test tlsIO-1
20e0: 2e 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .1 {arg parsing
20f0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
2100: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
2110: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
2120: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
2130: 76 65 72 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d ver} msg] $msg.}
2140: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
2150: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
2160: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
2170: 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f r command ?optio
2180: 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ns? port"}}..tes
2190: 74 20 74 6c 73 49 4f 2d 31 2e 32 20 7b 61 72 67 t tlsIO-1.2 {arg
21a0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
21b0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
21c0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
21d0: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
21e0: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f cket -server foo
21f0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2200: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2210: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2220: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 socket -server c
2230: 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f ommand ?options?
2240: 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 port"}}..test t
2250: 6c 73 49 4f 2d 31 2e 33 20 7b 61 72 67 20 70 61 lsIO-1.3 {arg pa
2260: 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 rsing for socket
2270: 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 command} {socke
2280: 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 t} {. list [c
2290: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
22a0: 74 20 2d 6d 79 61 64 64 72 7d 20 6d 73 67 5d 20 t -myaddr} msg]
22b0: 24 6d 73 67 0a 7d 20 7b 31 20 7b 22 2d 6d 79 61 $msg.} {1 {"-mya
22c0: 64 64 72 22 20 6f 70 74 69 6f 6e 20 6d 75 73 74 ddr" option must
22d0: 20 62 65 20 66 6f 6c 6c 6f 77 65 64 20 62 79 20 be followed by
22e0: 76 61 6c 75 65 7d 7d 0a 0a 74 65 73 74 20 74 6c value}}..test tl
22f0: 73 49 4f 2d 31 2e 34 20 7b 61 72 67 20 70 61 72 sIO-1.4 {arg par
2300: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2310: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2320: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2330: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2340: 20 2d 6d 79 61 64 64 72 20 31 32 37 2e 30 2e 30 -myaddr 127.0.0
2350: 2e 31 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 .1} msg] $msg.}
2360: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
2370: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
2380: 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e ::socket ?option
2390: 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a s? host port"}}.
23a0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 35 20 .test tlsIO-1.5
23b0: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
23c0: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
23d0: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
23e0: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
23f0: 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 ::socket -myport
2400: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2410: 20 7b 22 2d 6d 79 70 6f 72 74 22 20 6f 70 74 69 {"-myport" opti
2420: 6f 6e 20 6d 75 73 74 20 62 65 20 66 6f 6c 6c 6f on must be follo
2430: 77 65 64 20 62 79 20 76 61 6c 75 65 7d 7d 0a 0a wed by value}}..
2440: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 36 20 7b test tlsIO-1.6 {
2450: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2460: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2470: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2480: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2490: 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 :socket -myport
24a0: 78 78 78 78 7d 20 6d 73 67 5d 20 24 6d 73 67 0a xxxx} msg] $msg.
24b0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
24c0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
24d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
24e0: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
24f0: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2500: 37 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 7 {arg parsing f
2510: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
2520: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2530: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2540: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 70 6f ls::socket -mypo
2550: 72 74 20 32 35 32 32 7d 20 6d 73 67 5d 20 24 6d rt 2522} msg] $m
2560: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
2570: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
2580: 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f "tls::socket ?o
2590: 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 ptions? host por
25a0: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
25b0: 2d 31 2e 38 20 7b 61 72 67 20 70 61 72 73 69 6e -1.8 {arg parsin
25c0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
25d0: 6d 61 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 69 6e mand} -constrain
25e0: 74 73 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 ts {socket} -bod
25f0: 79 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 y {. list [ca
2600: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2610: 20 2d 66 72 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 -froboz} msg] $
2620: 6d 73 67 0a 7d 20 2d 6d 61 74 63 68 20 67 6c 6f msg.} -match glo
2630: 62 20 2d 72 65 73 75 6c 74 20 7b 31 20 7b 62 61 b -result {1 {ba
2640: 64 20 6f 70 74 69 6f 6e 20 22 2d 66 72 6f 62 6f d option "-frobo
2650: 7a 22 3a 20 6d 75 73 74 20 62 65 20 6f 6e 65 20 z": must be one
2660: 6f 66 20 2a 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 of *}}..test tls
2670: 49 4f 2d 31 2e 39 20 7b 61 72 67 20 70 61 72 73 IO-1.9 {arg pars
2680: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
2690: 6f 6d 6d 61 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 ommand} -constra
26a0: 69 6e 74 73 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 ints {socket} -b
26b0: 6f 64 79 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b ody {. list [
26c0: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
26d0: 65 74 20 2d 73 65 72 76 65 72 20 66 6f 6f 20 2d et -server foo -
26e0: 6d 79 70 6f 72 74 20 32 35 32 31 20 33 33 33 33 myport 2521 3333
26f0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 2d 6d } msg] $msg.} -m
2700: 61 74 63 68 20 67 6c 6f 62 20 2d 72 65 73 75 6c atch glob -resul
2710: 74 20 7b 31 20 7b 62 61 64 20 6f 70 74 69 6f 6e t {1 {bad option
2720: 20 22 2d 6d 79 70 6f 72 74 22 3a 20 6d 75 73 74 "-myport": must
2730: 20 62 65 20 6f 6e 65 20 6f 66 20 2a 7d 7d 0a 0a be one of *}}..
2740: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 30 20 test tlsIO-1.10
2750: 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 {arg parsing for
2760: 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d socket command}
2770: 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 {socket} {.
2780: 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 list [catch {tls
2790: 3a 3a 73 6f 63 6b 65 74 20 68 6f 73 74 20 32 35 ::socket host 25
27a0: 32 38 20 2d 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 28 -junk} msg] $
27b0: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
27c0: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
27d0: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f e "tls::socket ?
27e0: 6f 70 74 69 6f 6e 73 3f 20 68 6f 73 74 20 70 6f options? host po
27f0: 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 rt"}}..test tlsI
2800: 4f 2d 31 2e 31 31 20 7b 61 72 67 20 70 61 72 73 O-1.11 {arg pars
2810: 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 ing for socket c
2820: 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d ommand} {socket}
2830: 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 {. list [cat
2840: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
2850: 2d 73 65 72 76 65 72 20 63 61 6c 6c 62 61 63 6b -server callback
2860: 20 32 35 32 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 2520 --} msg] $
2870: 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 msg.} {1 {wrong
2880: 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 # args: should b
2890: 65 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d e "tls::socket -
28a0: 73 65 72 76 65 72 20 63 6f 6d 6d 61 6e 64 20 3f server command ?
28b0: 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d options? port"}}
28c0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 ..test tlsIO-1.1
28d0: 32 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 2 {arg parsing f
28e0: 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e or socket comman
28f0: 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 d} {socket} {.
2900: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
2910: 6c 73 3a 3a 73 6f 63 6b 65 74 20 66 6f 6f 20 62 ls::socket foo b
2920: 61 64 70 6f 72 74 7d 20 6d 73 67 5d 20 24 6d 73 adport} msg] $ms
2930: 67 0a 7d 20 7b 31 20 7b 65 78 70 65 63 74 65 64 g.} {1 {expected
2940: 20 69 6e 74 65 67 65 72 20 62 75 74 20 67 6f 74 integer but got
2950: 20 22 62 61 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 "badport"}}..te
2960: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 st tlsIO-2.1 {tc
2970: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 p connection} {s
2980: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
2990: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
29a0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
29b0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
29c0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
29d0: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
29e0: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
29f0: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
2a00: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
2a10: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
2a20: 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 2000 "set x time
2a30: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 7d 0a 20 20 d_out"]. }.
2a40: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 puts $f "set f
2a50: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
2a60: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
2a70: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
2a80: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
2a90: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
2aa0: 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 rverKey 8828 \]"
2ab0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
2ac0: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
2ad0: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 e addr port} {..
2ae0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 global x..
2af0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
2b00: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
2b10: 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 file..}..puts re
2b20: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
2b30: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
2b40: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
2b50: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
2b60: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
2b70: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
2b80: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
2b90: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
2ba0: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
2bb0: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
2bc0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 s::socket -certf
2bd0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
2be0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2bf0: 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 \..-keyfile $cli
2c00: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
2c10: 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 8828} msg]} {.
2c20: 20 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 set x $ms
2c30: 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 g. } else {.
2c40: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
2c50: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
2c60: 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 close $msg.
2c70: 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 }. lappend
2c80: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
2c90: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
2ca0: 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 x.} {ready done
2cb0: 20 7b 7d 7d 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 {}}..if [info e
2cc0: 78 69 73 74 73 20 70 6f 72 74 5d 20 7b 0a 20 20 xists port] {.
2cd0: 20 20 69 6e 63 72 20 70 6f 72 74 0a 7d 20 65 6c incr port.} el
2ce0: 73 65 20 7b 0a 20 20 20 20 73 65 74 20 70 6f 72 se {. set por
2cf0: 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 72 t [expr {$tlsSer
2d00: 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 verPort + [pid]%
2d10: 31 30 32 34 7d 5d 0a 7d 0a 0a 74 65 73 74 20 74 1024}].}..test t
2d20: 6c 73 49 4f 2d 32 2e 32 20 7b 74 63 70 20 63 6f lsIO-2.2 {tcp co
2d30: 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c nnection with cl
2d40: 69 65 6e 74 20 70 6f 72 74 20 73 70 65 63 69 66 ient port specif
2d50: 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ied} {socket std
2d60: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
2d70: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
2d80: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
2d90: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
2da0: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
2db0: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
2dc0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
2dd0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
2de0: 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 20 tls..set timer
2df0: 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 74 [after 2000 "set
2e00: 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a x done"]. }.
2e10: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
2e20: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
2e30: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
2e40: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
2e50: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
2e60: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
2e70: 73 65 72 76 65 72 4b 65 79 20 38 38 32 39 20 5c serverKey 8829 \
2e80: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
2e90: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
2ea0: 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b ock addr port} {
2eb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f . glo
2ec0: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
2ed0: 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 puts "[gets $s
2ee0: 6f 63 6b 5d 20 24 70 6f 72 74 22 0a 20 20 20 20 ock] $port".
2ef0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
2f00: 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 ock.
2f10: 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 set x done..}..p
2f20: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
2f30: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
2f40: 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 65 20 24 $timer..close $
2f50: 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 f. }. clos
2f60: 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b e $f. set f [
2f70: 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a open "|[list $::
2f80: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
2f90: 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 script]" r].
2fa0: 20 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 67 gets $f x. g
2fb0: 6c 6f 62 61 6c 20 70 6f 72 74 0a 20 20 20 20 69 lobal port. i
2fc0: 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a f {[catch {tls::
2fd0: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 24 socket -myport $
2fe0: 70 6f 72 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c port \..-certfil
2ff0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
3000: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
3010: 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e .-keyfile $clien
3020: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
3030: 38 32 39 7d 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 829} sock]} {.
3040: 20 20 20 20 20 20 73 65 74 20 78 20 24 73 6f 63 set x $soc
3050: 6b 0a 09 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 k..catch {close
3060: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 [tls::socket 127
3070: 2e 30 2e 30 2e 31 20 38 38 32 39 5d 7d 0a 20 20 .0.0.1 8829]}.
3080: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
3090: 20 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 puts $sock he
30a0: 6c 6c 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b llo..flush $sock
30b0: 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 . lappend
30c0: 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 x [gets $f].
30d0: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b close $sock
30e0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
30f0: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
3100: 5b 6c 69 73 74 20 72 65 61 64 79 20 22 68 65 6c [list ready "hel
3110: 6c 6f 20 24 70 6f 72 74 22 5d 0a 0a 74 65 73 74 lo $port"]..test
3120: 20 74 6c 73 49 4f 2d 32 2e 33 20 7b 74 63 70 20 tlsIO-2.3 {tcp
3130: 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 connection with
3140: 63 6c 69 65 6e 74 20 69 6e 74 65 72 66 61 63 65 client interface
3150: 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 6f 63 specified} {soc
3160: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3170: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
3180: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
3190: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
31a0: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
31b0: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 et auto_path $au
31c0: 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 to_path]. put
31d0: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
31e0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
31f0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
3200: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
3210: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
3220: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
3230: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
3240: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
3250: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
3260: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
3270: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
3280: 20 38 38 33 30 20 5c 5d 22 0a 20 20 20 20 70 75 8830 \]". pu
3290: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
32a0: 63 65 70 74 20 7b 73 6f 63 6b 20 61 64 64 72 20 cept {sock addr
32b0: 70 6f 72 74 7d 20 7b 0a 20 20 20 20 20 20 20 20 port} {.
32c0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
32d0: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 22 5b puts "[
32e0: 67 65 74 73 20 24 73 6f 63 6b 5d 20 24 61 64 64 gets $sock] $add
32f0: 72 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 r". c
3300: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 lose $sock.
3310: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
3320: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
3330: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
3340: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
3350: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 close $f. }.
3360: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3370: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
3380: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
3390: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
33a0: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 r]. gets $f
33b0: 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 x. if {[catch
33c0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
33d0: 79 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 20 yaddr 127.0.0.1
33e0: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
33f0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
3400: 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 $caCert \..-key
3410: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
3420: 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 30 7d 20 127.0.0.1 8830}
3430: 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 sock]} {.
3440: 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 set x $sock.
3450: 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 } else {.
3460: 20 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c puts $sock hel
3470: 6c 6f 0a 09 63 61 74 63 68 20 7b 66 6c 75 73 68 lo..catch {flush
3480: 20 24 73 6f 63 6b 7d 0a 20 20 20 20 20 20 20 20 $sock}.
3490: 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 20 lappend x [gets
34a0: 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f 73 $f]. clos
34b0: 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 e $sock. }.
34c0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
34d0: 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 7b 68 et x.} {ready {h
34e0: 65 6c 6c 6f 20 31 32 37 2e 30 2e 30 2e 31 7d 7d ello 127.0.0.1}}
34f0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 34 ..test tlsIO-2.4
3500: 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e {tcp connection
3510: 20 77 69 74 68 20 73 65 72 76 65 72 20 69 6e 74 with server int
3520: 65 72 66 61 63 65 20 73 70 65 63 69 66 69 65 64 erface specified
3530: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
3540: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
3550: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
3560: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3570: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
3580: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
3590: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
35a0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
35b0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
35c0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
35d0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
35e0: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
35f0: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3600: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3610: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
3620: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3630: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3640: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
3650: 76 65 72 4b 65 79 20 2d 6d 79 61 64 64 72 20 6c verKey -myaddr l
3660: 6f 63 61 6c 68 6f 73 74 20 38 38 33 31 20 5c 5d ocalhost 8831 \]
3670: 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ". puts $f {.
3680: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f .proc accept {so
3690: 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a ck addr port} {.
36a0: 20 20 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 glob
36b0: 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 al x.
36c0: 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f puts "[gets $so
36d0: 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 ck]".
36e0: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
36f0: 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 set x d
3700: 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 one..}..puts rea
3710: 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 dy..vwait x..aft
3720: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
3730: 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d ..close $f. }
3740: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3750: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
3760: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
3770: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
3780: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
3790: 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 f x. if {[cat
37a0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
37b0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
37c0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
37d0: 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c aCert \..-keyfil
37e0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 6c 6f 63 e $clientKey loc
37f0: 61 6c 68 6f 73 74 20 38 38 33 31 7d 20 73 6f 63 alhost 8831} soc
3800: 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 k]} {. se
3810: 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 t x $sock. }
3820: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 else {. p
3830: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a uts $sock hello.
3840: 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 .flush $sock.
3850: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b lappend x [
3860: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 gets $f].
3870: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3880: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3890: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 set x.} {rea
38a0: 64 79 20 68 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 dy hello}..test
38b0: 74 6c 73 49 4f 2d 32 2e 35 20 7b 74 63 70 20 63 tlsIO-2.5 {tcp c
38c0: 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 68 20 72 onnection with r
38d0: 65 64 75 6e 64 61 6e 74 20 73 65 72 76 65 72 20 edundant server
38e0: 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 port} {socket st
38f0: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
3900: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
3910: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
3920: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
3930: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
3940: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
3950: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
3960: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
3970: 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d 65 72 e tls..set timer
3980: 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 73 65 [after 2000 "se
3990: 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 20 7d t x done"]. }
39a0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 . puts $f "se
39b0: 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t f \[tls::socke
39c0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
39d0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
39e0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
39f0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
3a00: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 32 20 $serverKey 8832
3a10: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
3a20: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
3a30: 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 7d 20 sock addr port}
3a40: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 67 6c {. gl
3a50: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
3a60: 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 20 24 puts "[gets $
3a70: 73 6f 63 6b 5d 22 0a 20 20 20 20 20 20 20 20 20 sock]".
3a80: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
3a90: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
3aa0: 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 done..}..puts r
3ab0: 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 eady..vwait x..a
3ac0: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
3ad0: 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 20 er..close $f.
3ae0: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3af0: 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 set f [open
3b00: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
3b10: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
3b20: 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 pt]" r]. gets
3b30: 20 24 66 20 78 0a 20 20 20 20 69 66 20 7b 5b 63 $f x. if {[c
3b40: 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 atch {tls::socke
3b50: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
3b60: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
3b70: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
3b80: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
3b90: 32 37 2e 30 2e 30 2e 31 20 38 38 33 32 7d 20 73 27.0.0.1 8832} s
3ba0: 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 ock]} {.
3bb0: 73 65 74 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 set x $sock.
3bc0: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
3bd0: 20 70 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c puts $sock hell
3be0: 6f 0a 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 o..flush $sock.
3bf0: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 lappend x
3c00: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 [gets $f].
3c10: 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 close $sock.
3c20: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
3c30: 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 72 f. set x.} {r
3c40: 65 61 64 79 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 eady hello}.test
3c50: 20 74 6c 73 49 4f 2d 32 2e 36 20 7b 74 63 70 20 tlsIO-2.6 {tcp
3c60: 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 connection} {soc
3c70: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 ket} {. set s
3c80: 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 tatus ok. if
3c90: 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 73 6f {![catch {set so
3ca0: 63 6b 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ck [tls::socket
3cb0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 33 5d 7d 127.0.0.1 8833]}
3cc0: 5d 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 ]} {..if {![catc
3cd0: 68 20 7b 67 65 74 73 20 24 73 6f 63 6b 7d 5d 7d h {gets $sock}]}
3ce0: 20 7b 0a 09 20 20 20 20 73 65 74 20 73 74 61 74 {.. set stat
3cf0: 75 73 20 62 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c us broken..}..cl
3d00: 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a ose $sock. }.
3d10: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 0a 7d set status.}
3d20: 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ok..test tlsIO-
3d30: 32 2e 37 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2.7 {echo server
3d40: 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 , one line} {soc
3d50: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
3d60: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
3d70: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
3d80: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
3d90: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
3da0: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 et auto_path $au
3db0: 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 to_path]. put
3dc0: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
3dd0: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
3de0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
3df0: 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 00 "set x done"]
3e00: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
3e10: 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a $f "set f \[tls:
3e20: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 :socket -server
3e30: 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c 65 accept -certfile
3e40: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
3e50: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
3e60: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
3e70: 20 38 38 33 34 20 5c 5d 22 0a 20 20 20 20 70 75 8834 \]". pu
3e80: 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 ts $f {..proc ac
3e90: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 20 cept {s a p} {.
3ea0: 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 65 filee
3eb0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
3ec0: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
3ed0: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
3ee0: 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 $s -translation
3ef0: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
3f00: 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 ne. }..pr
3f10: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
3f20: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
3f30: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
3f40: 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b if {[eof $s]} {
3f50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3f60: 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 global x.
3f70: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
3f80: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
3f90: 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 set x done
3fa0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 . }
3fb0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20 else {.
3fc0: 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 puts $s
3fd0: 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $l.
3fe0: 7d 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 }..}..puts ready
3ff0: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
4000: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
4010: 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 64 close $f..puts d
4020: 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c one. }. cl
4030: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
4040: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
4050: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
4060: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
4070: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
4080: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
4090: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 t -certfile $cli
40a0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
40b0: 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 $caCert \..-keyf
40c0: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 ile $clientKey 1
40d0: 32 37 2e 30 2e 30 2e 31 20 38 38 33 34 5d 0a 20 27.0.0.1 8834].
40e0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
40f0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
4100: 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 -translation lf
4110: 0a 20 20 20 20 70 75 74 73 20 24 73 20 22 68 65 . puts $s "he
4120: 6c 6c 6f 20 61 62 63 64 65 66 67 68 69 6a 6b 6c llo abcdefghijkl
4130: 6d 6e 6f 70 22 0a 20 20 20 20 61 66 74 65 72 20 mnop". after
4140: 31 30 30 30 0a 20 20 20 20 73 65 74 20 78 20 5b 1000. set x [
4150: 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f gets $s]. clo
4160: 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 79 20 se $s. set y
4170: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c [gets $f]. cl
4180: 6f 73 65 20 24 66 0a 20 20 20 20 6c 69 73 74 20 ose $f. list
4190: 24 78 20 24 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 $x $y.} {{hello
41a0: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop
41b0: 7d 20 64 6f 6e 65 7d 0a 0a 74 65 73 74 20 74 6c } done}..test tl
41c0: 73 49 4f 2d 32 2e 38 20 7b 65 63 68 6f 20 73 65 sIO-2.8 {echo se
41d0: 72 76 65 72 2c 20 6c 6f 6f 70 20 35 30 20 74 69 rver, loop 50 ti
41e0: 6d 65 73 2c 20 73 69 6e 67 6c 65 20 63 6f 6e 6e mes, single conn
41f0: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 ection} {socket
4200: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 73 65 74 stdio} {. set
4210: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
4220: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
4230: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
4240: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
4250: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 20 20 20 puts $f {.
4260: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
4270: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
4280: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
4290: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
42a0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
42b0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
42c0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
42d0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
42e0: 65 72 4b 65 79 20 38 38 33 35 20 5c 5d 22 0a 20 erKey 8835 \]".
42f0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
4300: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
4310: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
4320: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
4330: 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f dable [list echo
4340: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
4350: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
4360: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
4370: 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 }..proc e
4380: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 cho {s} {..
4390: 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 global i.
43a0: 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 set l [get
43b0: 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 s $s].
43c0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
43d0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
43e0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 global x.
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c cl
4400: 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 ose $s.
4410: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f set x do
4420: 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ne.
4430: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 20 20 } else {..
4440: 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 incr i.
4450: 20 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 puts
4460: 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 $s $l.
4470: 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 }..}..set i 0
4480: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 ..puts ready..se
4490: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 t timer [after 2
44a0: 30 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 0000 "set x done
44b0: 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 "]..vwait x..aft
44c0: 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 er cancel $timer
44d0: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 ..close $f..puts
44e0: 20 22 64 6f 6e 65 20 24 69 22 0a 20 20 20 20 7d "done $i". }
44f0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
4500: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
4510: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
4520: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
4530: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
4540: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
4550: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
4560: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
4570: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4580: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
4590: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
45a0: 38 38 33 35 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8835]. fconfi
45b0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
45c0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 63 61 74 63 ng line. catc
45d0: 68 20 7b 0a 09 66 6f 72 20 7b 73 65 74 20 78 20 h {..for {set x
45e0: 30 7d 20 7b 24 78 20 3c 20 35 30 7d 20 7b 69 6e 0} {$x < 50} {in
45f0: 63 72 20 78 7d 20 7b 0a 09 20 20 20 20 70 75 74 cr x} {.. put
4600: 73 20 24 73 20 22 68 65 6c 6c 6f 20 61 62 63 64 s $s "hello abcd
4610: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 efghijklmnop"..
4620: 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 20 20 gets $s..}.
4630: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
4640: 0a 20 20 20 20 63 61 74 63 68 20 7b 73 65 74 20 . catch {set
4650: 78 20 5b 67 65 74 73 20 24 66 5d 7d 0a 20 20 20 x [gets $f]}.
4660: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4670: 74 20 78 0a 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a t x.} {done 50}.
4680: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 39 20 .test tlsIO-2.9
4690: 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 {socket conflict
46a0: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
46b0: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
46c0: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
46d0: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 20 r accept 8828].
46e0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
46f0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
4700: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
4710: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
4720: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
4730: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
4740: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
4750: 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 f {..package req
4760: 75 69 72 65 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 uire tls..tls::s
4770: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4780: 63 65 70 74 20 38 38 32 38 0a 20 20 20 20 7d 0a cept 8828. }.
4790: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
47a0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
47b0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
47c0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
47d0: 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 " r]. gets $f
47e0: 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 0a 20 . after 100.
47f0: 20 20 20 73 65 74 20 78 20 5b 6c 69 73 74 20 5b set x [list [
4800: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 66 7d catch {close $f}
4810: 20 6d 73 67 5d 20 5b 73 74 72 69 6e 67 20 72 61 msg] [string ra
4820: 6e 67 65 20 24 6d 73 67 20 30 20 34 33 5d 5d 0a nge $msg 0 43]].
4830: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
4840: 20 73 65 74 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 set x.} {1 {cou
4850: 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 ldn't open socke
4860: 74 3a 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 t: address alrea
4870: 64 79 20 69 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 dy in use}}..tes
4880: 74 20 74 6c 73 49 4f 2d 32 2e 31 30 20 7b 63 6c t tlsIO-2.10 {cl
4890: 6f 73 65 20 6f 6e 20 61 63 63 65 70 74 2c 20 61 ose on accept, a
48a0: 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 6c ccepted socket l
48b0: 69 76 65 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b ives} {socket} {
48c0: 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 30 0a . set done 0.
48d0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
48e0: 66 74 65 72 20 32 30 30 30 30 20 22 73 65 74 20 fter 20000 "set
48f0: 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d done timed_out"]
4900: 0a 20 20 20 20 73 65 74 20 73 73 20 5b 74 6c 73 . set ss [tls
4910: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4920: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
4930: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
4940: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a afile $caCert \.
4950: 09 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 .-keyfile $serve
4960: 72 4b 65 79 20 38 38 33 30 5d 0a 20 20 20 20 70 rKey 8830]. p
4970: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
4980: 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 73 0a p} {..global ss.
4990: 09 63 6c 6f 73 65 20 24 73 73 0a 09 66 69 6c 65 .close $ss..file
49a0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
49b0: 65 20 22 72 65 61 64 69 74 20 24 73 22 0a 09 66 e "readit $s"..f
49c0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 74 72 configure $s -tr
49d0: 61 6e 73 20 6c 66 0a 20 20 20 20 7d 0a 20 20 20 ans lf. }.
49e0: 20 70 72 6f 63 20 72 65 61 64 69 74 20 7b 73 7d proc readit {s}
49f0: 20 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a {..global done.
4a00: 09 67 65 74 73 20 24 73 0a 09 63 6c 6f 73 65 20 .gets $s..close
4a10: 24 73 0a 09 73 65 74 20 64 6f 6e 65 20 31 0a 20 $s..set done 1.
4a20: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 73 20 }. set cs
4a30: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
4a40: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
4a50: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4a60: 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 rt \..-keyfile $
4a70: 63 6c 69 65 6e 74 4b 65 79 20 6c 6f 63 61 6c 68 clientKey localh
4a80: 6f 73 74 20 38 38 33 30 5d 0a 20 20 20 20 63 6c ost 8830]. cl
4a90: 6f 73 65 20 24 63 73 0a 0a 20 20 20 20 76 77 61 ose $cs.. vwa
4aa0: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
4ab0: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
4ac0: 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 31 set done.} 1
4ad0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 ..test tlsIO-2.1
4ae0: 31 20 7b 64 65 74 65 63 74 69 6e 67 20 6e 65 77 1 {detecting new
4af0: 20 64 61 74 61 7d 20 7b 73 6f 63 6b 65 74 7d 20 data} {socket}
4b00: 7b 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 {. proc accep
4b10: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f t {s a p} {..glo
4b20: 62 61 6c 20 73 6f 63 6b 0a 09 23 20 77 68 65 6e bal sock..# when
4b30: 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f doing an in-pro
4b40: 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 cess client/serv
4b50: 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 er test, both si
4b60: 64 65 73 20 6e 65 65 64 0a 09 23 20 74 6f 20 62 des need..# to b
4b70: 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 e non-blocking f
4b80: 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 or the TLS hands
4b90: 68 61 6b 65 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 hake. Also make
4ba0: 20 73 75 72 65 0a 09 23 20 74 6f 20 72 65 74 75 sure..# to retu
4bb0: 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 rn the channel t
4bc0: 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 o line buffering
4bd0: 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e 66 69 67 75 mode...fconfigu
4be0: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
4bf0: 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 0 -buffering lin
4c00: 65 0a 09 73 65 74 20 73 6f 63 6b 20 24 73 0a 09 e..set sock $s..
4c10: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
4c20: 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 dable [list do_h
4c30: 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a 20 20 20 andshake $s].
4c40: 20 7d 0a 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }.. set s [t
4c50: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
4c60: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 er accept \..
4c70: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
4c80: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
4c90: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
4ca0: 24 73 65 72 76 65 72 4b 65 79 20 38 34 30 30 5d $serverKey 8400]
4cb0: 0a 20 20 20 20 73 65 74 20 73 6f 63 6b 20 22 22 . set sock ""
4cc0: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
4cd0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
4ce0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
4cf0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4d00: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
4d10: 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 ntKey 127.0.0.1
4d20: 38 34 30 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 8400]. # when
4d30: 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f doing an in-pro
4d40: 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 cess client/serv
4d50: 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 er test, both si
4d60: 64 65 73 20 6e 65 65 64 0a 20 20 20 20 23 20 74 des need. # t
4d70: 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e o be non-blockin
4d80: 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 g for the TLS ha
4d90: 6e 64 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 ndshake Also ma
4da0: 6b 65 20 73 75 72 65 20 74 6f 0a 20 20 20 20 23 ke sure to. #
4db0: 20 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e return the chan
4dc0: 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 nel to line buff
4dd0: 65 72 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 ering mode (TLS
4de0: 73 65 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 sets it to 'none
4df0: 27 29 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 ').. fconfigu
4e00: 72 65 20 24 73 32 20 2d 62 6c 6f 63 6b 69 6e 67 re $s2 -blocking
4e10: 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 0 -buffering li
4e20: 6e 65 0a 20 20 20 20 76 77 61 69 74 20 73 6f 63 ne. vwait soc
4e30: 6b 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 6f k. puts $s2 o
4e40: 6e 65 0a 20 20 20 20 66 6c 75 73 68 20 24 73 32 ne. flush $s2
4e50: 0a 20 20 20 20 23 20 6e 65 65 64 20 75 70 64 61 . # need upda
4e60: 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 54 te to complete T
4e70: 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 69 6e 2d LS handshake in-
4e80: 70 72 6f 63 65 73 73 0a 20 20 20 20 75 70 64 61 process. upda
4e90: 74 65 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 te. after 500
4ea0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
4eb0: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
4ec0: 30 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0. set result
4ed0: 20 61 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a a:[gets $sock].
4ee0: 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 lappend resu
4ef0: 6c 74 20 62 3a 5b 67 65 74 73 20 24 73 6f 63 6b lt b:[gets $sock
4f00: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4f10: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
4f20: 20 31 0a 20 20 20 20 70 75 74 73 20 24 73 32 20 1. puts $s2
4f30: 74 77 6f 0a 20 20 20 20 66 6c 75 73 68 20 24 73 two. flush $s
4f40: 32 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 2. fconfigure
4f50: 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 $sock -blocking
4f60: 20 31 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 1. lappend r
4f70: 65 73 75 6c 74 20 63 3a 5b 67 65 74 73 20 24 73 esult c:[gets $s
4f80: 6f 63 6b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 ock]. fconfig
4f90: 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b ure $sock -block
4fa0: 69 6e 67 20 31 0a 20 20 20 20 63 6c 6f 73 65 20 ing 1. close
4fb0: 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s2. close $s
4fc0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b . close $sock
4fd0: 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a . set result.
4fe0: 7d 20 7b 61 3a 6f 6e 65 20 62 3a 20 63 3a 74 77 } {a:one b: c:tw
4ff0: 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 o}..test tlsIO-2
5000: 2e 31 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 .12 {tcp connect
5010: 69 6f 6e 3b 20 6e 6f 20 63 65 72 74 69 66 69 63 ion; no certific
5020: 61 74 65 73 20 73 70 65 63 69 66 69 65 64 7d 20 ates specified}
5030: 5c 0a 09 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f \..{socket stdio
5040: 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 unixOnly} {.
5050: 20 23 20 54 68 65 72 65 20 69 73 20 61 20 64 65 # There is a de
5060: 62 75 67 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e bug assertion on
5070: 20 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 Windows/SSL tha
5080: 74 20 63 61 75 73 65 73 20 61 20 63 72 61 73 68 t causes a crash
5090: 20 77 68 65 6e 20 74 68 65 0a 20 20 20 20 23 20 when the. #
50a0: 63 65 72 74 69 66 69 63 61 74 65 20 69 73 6e 27 certificate isn'
50b0: 74 20 73 70 65 63 69 66 69 65 64 2e 0a 20 20 20 t specified..
50c0: 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 removeFile scri
50d0: 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 pt. set f [op
50e0: 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 en script w].
50f0: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
5100: 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 et auto_path $au
5110: 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 to_path]. put
5120: 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 s $f {..package
5130: 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 require tls..set
5140: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
5150: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
5160: 6f 75 74 22 5d 0a 09 73 65 74 20 66 20 5b 74 6c out"]..set f [tl
5170: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
5180: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 09 r accept 8828]..
5190: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 66 69 6c proc accept {fil
51a0: 65 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 09 e addr port} {..
51b0: 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 global x..
51c0: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
51d0: 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 close $
51e0: 66 69 6c 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 file..}..puts re
51f0: 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 61 66 ady..vwait x..af
5200: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
5210: 72 0a 09 63 6c 6f 73 65 20 24 66 0a 09 70 75 74 r..close $f..put
5220: 73 20 24 78 0a 20 20 20 20 7d 0a 20 20 20 20 63 s $x. }. c
5230: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
5240: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
5250: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
5260: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
5270: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
5280: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
5290: 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e s::socket 127.0.
52a0: 30 2e 31 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 0.1 8828} msg]}
52b0: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
52c0: 24 6d 73 67 0a 20 20 20 20 7d 20 65 6c 73 65 20 $msg. } else
52d0: 7b 0a 20 20 20 20 20 20 20 20 6c 61 70 70 65 6e {. lappen
52e0: 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 d x [gets $f].
52f0: 20 20 20 20 20 20 63 6c 6f 73 65 20 24 6d 73 67 close $msg
5300: 0a 20 20 20 20 7d 0a 20 20 20 20 6c 61 70 70 65 . }. lappe
5310: 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 nd x [gets $f].
5320: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
5330: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 set x.} {ready d
5340: 6f 6e 65 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c one {}}..test tl
5350: 73 49 4f 2d 33 2e 31 20 7b 73 6f 63 6b 65 74 20 sIO-3.1 {socket
5360: 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 conflict} {socke
5370: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
5380: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
5390: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
53a0: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
53b0: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
53c0: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
53d0: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
53e0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
53f0: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
5400: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
5410: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
5420: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
5430: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
5440: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
5450: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5460: 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c serverKey 8828 \
5470: 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b ]". puts $f {
5480: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 67 65 ..puts ready..ge
5490: 74 73 20 73 74 64 69 6e 0a 09 63 6c 6f 73 65 20 ts stdin..close
54a0: 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f $f. }. clo
54b0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 se $f. set f
54c0: 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a [open "|[list $:
54d0: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
54e0: 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 t script]" r+].
54f0: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
5500: 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 et x [list [catc
5510: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c h {tls::socket \
5520: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
5530: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
5540: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
5550: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
5560: 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 20 61 \. .-server a
5570: 63 63 65 70 74 20 38 38 32 38 7d 20 6d 73 67 5d ccept 8828} msg]
5580: 20 5c 0a 09 09 24 6d 73 67 5d 0a 20 20 20 20 70 \...$msg]. p
5590: 75 74 73 20 24 66 20 62 79 65 0a 20 20 20 20 63 uts $f bye. c
55a0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
55b0: 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 x.} {1 {couldn't
55c0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
55d0: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
55e0: 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 use}}..test tls
55f0: 49 4f 2d 33 2e 32 20 7b 73 65 72 76 65 72 20 77 IO-3.2 {server w
5600: 69 74 68 20 73 65 76 65 72 61 6c 20 63 6c 69 65 ith several clie
5610: 6e 74 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 nts} {socket std
5620: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
5630: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
5640: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
5650: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
5660: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
5670: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
5680: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
5690: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
56a0: 20 74 6c 73 0a 09 73 65 74 20 74 31 20 5b 61 66 tls..set t1 [af
56b0: 74 65 72 20 33 30 30 30 30 20 22 73 65 74 20 78 ter 30000 "set x
56c0: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
56d0: 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 30 t t2 [after 3100
56e0: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
56f0: 75 74 22 5d 0a 09 73 65 74 20 74 33 20 5b 61 66 ut"]..set t3 [af
5700: 74 65 72 20 33 32 30 30 30 20 22 73 65 74 20 78 ter 32000 "set x
5710: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 73 65 timed_out"]..se
5720: 74 20 63 6f 75 6e 74 65 72 20 30 0a 20 20 20 20 t counter 0.
5730: 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 73 }. puts $f "s
5740: 65 74 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b et s \[tls::sock
5750: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
5760: 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 t -certfile $ser
5770: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
5780: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
5790: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 $serverKey 8828
57a0: 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 \]". puts $f
57b0: 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 {..proc accept
57c0: 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 66 {s a p} {.. f
57d0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
57e0: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
57f0: 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 $s].. fconfig
5800: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
5810: 67 20 6c 69 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 g line..}..proc
5820: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
5830: 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 global x.
5840: 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 set l [ge
5850: 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ts $s].
5860: 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d if {[eof $s]
5870: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
5880: 20 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 close $s.
5890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
58a0: 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 et x done.
58b0: 20 20 20 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a } else {.
58c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58d0: 20 70 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 puts $s $l.
58e0: 20 20 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 70 }..}..p
58f0: 75 74 73 20 72 65 61 64 79 0a 09 76 77 61 69 74 uts ready..vwait
5900: 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c x..after cancel
5910: 20 24 74 31 0a 09 76 77 61 69 74 20 78 0a 09 61 $t1..vwait x..a
5920: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 32 0a fter cancel $t2.
5930: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
5940: 63 61 6e 63 65 6c 20 24 74 33 0a 09 63 6c 6f 73 cancel $t3..clos
5950: 65 20 24 73 0a 09 70 75 74 73 20 24 78 0a 20 20 e $s..puts $x.
5960: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
5970: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5980: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
5990: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
59a0: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 73 65 ipt]" r+]. se
59b0: 74 20 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t x [gets $f].
59c0: 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 set s1 [tls::s
59d0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
59e0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
59f0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
5a00: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
5a10: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 entKey \.. 12
5a20: 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 7.0.0.1 8828].
5a30: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 fconfigure $s1
5a40: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
5a50: 0a 20 20 20 20 73 65 74 20 73 32 20 5b 74 6c 73 . set s2 [tls
5a60: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
5a70: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
5a80: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
5a90: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
5aa0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
5ab0: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 127.0.0.1 8828]
5ac0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5ad0: 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s2 -buffering l
5ae0: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b ine. set s3 [
5af0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
5b00: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
5b10: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
5b20: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
5b30: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
5b40: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 127.0.0.1 88
5b50: 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 28]. fconfigu
5b60: 72 65 20 24 73 33 20 2d 62 75 66 66 65 72 69 6e re $s3 -bufferin
5b70: 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b g line. for {
5b80: 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 set i 0} {$i < 1
5b90: 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 00} {incr i} {..
5ba0: 70 75 74 73 20 24 73 31 20 68 65 6c 6c 6f 2c 74 puts $s1 hello,t
5bb0: 6c 73 49 4f 2d 33 2e 32 2c 73 31 0a 09 67 65 74 lsIO-3.2,s1..get
5bc0: 73 20 24 73 31 0a 09 70 75 74 73 20 24 73 32 20 s $s1..puts $s2
5bd0: 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 2e 32 2c hello,tlsIO-3.2,
5be0: 73 32 0a 09 67 65 74 73 20 24 73 32 0a 09 70 75 s2..gets $s2..pu
5bf0: 74 73 20 24 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 ts $s3 hello,tls
5c00: 49 4f 2d 33 2e 32 2c 73 33 0a 09 67 65 74 73 20 IO-3.2,s3..gets
5c10: 24 73 33 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c $s3. }. cl
5c20: 6f 73 65 20 24 73 31 0a 20 20 20 20 63 6c 6f 73 ose $s1. clos
5c30: 65 20 24 73 32 0a 20 20 20 20 63 6c 6f 73 65 20 e $s2. close
5c40: 24 73 33 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $s3. lappend
5c50: 78 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 x [gets $f].
5c60: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
5c70: 20 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 x.} {ready done
5c80: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e }..test tlsIO-4.
5c90: 31 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 1 {server with s
5ca0: 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 everal clients}
5cb0: 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b {socket stdio} {
5cc0: 0a 20 20 20 20 23 20 68 61 76 65 20 73 65 65 6e . # have seen
5cd0: 20 69 6e 74 65 72 6d 69 74 74 65 6e 74 20 68 61 intermittent ha
5ce0: 6e 67 73 20 6f 6e 20 57 69 6e 64 6f 77 73 0a 20 ngs on Windows.
5cf0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
5d00: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
5d10: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
5d20: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
5d30: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
5d40: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
5d50: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
5d60: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 67 e require tls..g
5d70: 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a ets stdin. }.
5d80: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
5d90: 20 73 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s \[tls::socket
5da0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
5db0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
5dc0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
5dd0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
5de0: 2e 30 2e 31 20 38 38 32 38 20 5c 5d 22 0a 20 20 .0.1 8828 \]".
5df0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 66 63 6f puts $f {..fco
5e00: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
5e10: 65 72 69 6e 67 20 6c 69 6e 65 0a 09 66 6f 72 20 ering line..for
5e20: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
5e30: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
5e40: 09 20 20 20 20 70 75 74 73 20 24 73 20 68 65 6c . puts $s hel
5e50: 6c 6f 0a 09 20 20 20 20 67 65 74 73 20 24 73 0a lo.. gets $s.
5e60: 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 09 70 75 .}..close $s..pu
5e70: 74 73 20 62 79 65 0a 09 67 65 74 73 20 73 74 64 ts bye..gets std
5e80: 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f in. }. clo
5e90: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 70 31 se $f. set p1
5ea0: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
5eb0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
5ec0: 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a st script]" r+].
5ed0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
5ee0: 70 31 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 p1 -buffering li
5ef0: 6e 65 0a 20 20 20 20 73 65 74 20 70 32 20 5b 6f ne. set p2 [o
5f00: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
5f10: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
5f20: 73 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 script]" r+].
5f30: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 70 32 20 fconfigure $p2
5f40: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
5f50: 20 20 20 20 73 65 74 20 70 33 20 5b 6f 70 65 6e set p3 [open
5f60: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
5f70: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
5f80: 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 ipt]" r+]. fc
5f90: 6f 6e 66 69 67 75 72 65 20 24 70 33 20 2d 62 75 onfigure $p3 -bu
5fa0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
5fb0: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
5fc0: 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 a p} {..fconfigu
5fd0: 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 re $s -buffering
5fe0: 20 6c 69 6e 65 0a 09 66 69 6c 65 65 76 65 6e 74 line..fileevent
5ff0: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
6000: 73 74 20 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 st echo $s].
6010: 7d 0a 20 20 20 20 70 72 6f 63 20 65 63 68 6f 20 }. proc echo
6020: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a {s} {..global x.
6030: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
6040: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
6050: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
6060: 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 clos
6070: 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 e $s.
6080: 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 set x done.
6090: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 } else {.
60a0: 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 73 puts $s
60b0: 20 24 6c 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 $l. }.
60c0: 20 20 7d 0a 20 20 20 20 73 65 74 20 74 31 20 5b }. set t1 [
60d0: 61 66 74 65 72 20 33 30 30 30 30 20 22 73 65 74 after 30000 "set
60e0: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
60f0: 20 20 20 73 65 74 20 74 32 20 5b 61 66 74 65 72 set t2 [after
6100: 20 33 31 30 30 30 20 22 73 65 74 20 78 20 74 69 31000 "set x ti
6110: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 65 med_out"]. se
6120: 74 20 74 33 20 5b 61 66 74 65 72 20 33 32 30 30 t t3 [after 3200
6130: 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 0 "set x timed_o
6140: 75 74 22 5d 0a 20 20 20 20 73 65 74 20 73 20 5b ut"]. set s [
6150: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
6160: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
6170: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
6180: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6190: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
61a0: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
61b0: 70 74 20 38 38 32 38 5d 0a 20 20 20 20 70 75 74 pt 8828]. put
61c0: 73 20 24 70 31 20 6f 70 65 6e 0a 20 20 20 20 70 s $p1 open. p
61d0: 75 74 73 20 24 70 32 20 6f 70 65 6e 0a 20 20 20 uts $p2 open.
61e0: 20 70 75 74 73 20 24 70 33 20 6f 70 65 6e 0a 20 puts $p3 open.
61f0: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 76 vwait x. v
6200: 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 wait x. vwait
6210: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
6220: 63 65 6c 20 24 74 31 0a 20 20 20 20 61 66 74 65 cel $t1. afte
6230: 72 20 63 61 6e 63 65 6c 20 24 74 32 0a 20 20 20 r cancel $t2.
6240: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
6250: 33 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 3. close $s.
6260: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
6270: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 74 20 lappend l [list
6280: 70 31 20 5b 67 65 74 73 20 24 70 31 5d 20 24 78 p1 [gets $p1] $x
6290: 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 ]. lappend l
62a0: 5b 6c 69 73 74 20 70 32 20 5b 67 65 74 73 20 24 [list p2 [gets $
62b0: 70 32 5d 20 24 78 5d 0a 20 20 20 20 6c 61 70 70 p2] $x]. lapp
62c0: 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 33 20 5b end l [list p3 [
62d0: 67 65 74 73 20 24 70 33 5d 20 24 78 5d 0a 20 20 gets $p3] $x].
62e0: 20 20 70 75 74 73 20 24 70 31 20 62 79 65 0a 20 puts $p1 bye.
62f0: 20 20 20 70 75 74 73 20 24 70 32 20 62 79 65 0a puts $p2 bye.
6300: 20 20 20 20 70 75 74 73 20 24 70 33 20 62 79 65 puts $p3 bye
6310: 0a 20 20 20 20 63 6c 6f 73 65 20 24 70 31 0a 20 . close $p1.
6320: 20 20 20 63 6c 6f 73 65 20 24 70 32 0a 20 20 20 close $p2.
6330: 20 63 6c 6f 73 65 20 24 70 33 0a 20 20 20 20 73 close $p3. s
6340: 65 74 20 6c 0a 7d 20 7b 7b 70 31 20 62 79 65 20 et l.} {{p1 bye
6350: 64 6f 6e 65 7d 20 7b 70 32 20 62 79 65 20 64 6f done} {p2 bye do
6360: 6e 65 7d 20 7b 70 33 20 62 79 65 20 64 6f 6e 65 ne} {p3 bye done
6370: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 34 }}..test tlsIO-4
6380: 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 .2 {byte order p
6390: 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 roblems, socket
63a0: 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 numbers, htons}
63b0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
63c0: 65 74 20 78 20 6f 6b 0a 20 20 20 20 69 66 20 7b et x ok. if {
63d0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
63e0: 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 6f ket -server dodo
63f0: 20 30 78 33 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0x3000} msg]} {
6400: 0a 09 73 65 74 20 78 20 24 6d 73 67 0a 20 20 20 ..set x $msg.
6410: 20 7d 20 65 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 } else {..close
6420: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
6430: 73 65 74 20 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 set x.} ok..test
6440: 20 74 6c 73 49 4f 2d 35 2e 31 20 7b 62 79 74 65 tlsIO-5.1 {byte
6450: 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 2c order problems,
6460: 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 2c socket numbers,
6470: 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b htons} \..{sock
6480: 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 et unixOnly notR
6490: 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 oot} {. set x
64a0: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
64b0: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
64c0: 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 74 r}. if {![cat
64d0: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
64e0: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 31 -server dodo 0x1
64f0: 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 20 } msg]} {.
6500: 20 20 73 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 set x {htons p
6510: 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 roblem, should b
6520: 65 20 64 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 e disallowed, ar
6530: 65 20 79 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 e you running as
6540: 20 53 55 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 SU?}..close $ms
6550: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
6560: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
6570: 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f en socket: not o
6580: 77 6e 65 72 7d 0a 74 65 73 74 20 74 6c 73 49 4f wner}.test tlsIO
6590: 2d 35 2e 32 20 7b 62 79 74 65 20 6f 72 64 65 72 -5.2 {byte order
65a0: 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 problems, socke
65b0: 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f 6e 73 t numbers, htons
65c0: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
65d0: 20 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 set x {couldn't
65e0: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f open socket: po
65f0: 72 74 20 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 rt number too hi
6600: 67 68 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 gh}. if {![ca
6610: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
6620: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 -server dodo 0x
6630: 31 30 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 10000} msg]} {..
6640: 73 65 74 20 78 20 7b 70 6f 72 74 20 72 65 73 6f set x {port reso
6650: 6c 75 74 69 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 lution problem,
6660: 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c 6c should be disall
6670: 6f 77 65 64 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 owed}..close $ms
6680: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
6690: 78 0a 7d 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 x.} {couldn't op
66a0: 65 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 en socket: port
66b0: 6e 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d number too high}
66c0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 33 20 .test tlsIO-5.3
66d0: 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 {byte order prob
66e0: 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d lems, socket num
66f0: 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 bers, htons} \..
6700: 7b 73 6f 63 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 {socket unixOnly
6710: 20 6e 6f 74 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 notRoot} {.
6720: 73 65 74 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 set x {couldn't
6730: 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 open socket: not
6740: 20 6f 77 6e 65 72 7d 0a 20 20 20 20 69 66 20 7b owner}. if {
6750: 21 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f ![catch {tls::so
6760: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 64 6f 64 cket -server dod
6770: 6f 20 32 31 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 o 21} msg]} {..s
6780: 65 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 et x {htons prob
6790: 6c 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 lem, should be d
67a0: 69 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 isallowed, are y
67b0: 6f 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 ou running as SU
67c0: 3f 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 ?}..close $msg.
67d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d }. set x.}
67e0: 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 {couldn't open
67f0: 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 socket: not owne
6800: 72 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 36 r}..test tlsIO-6
6810: 2e 31 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 .1 {accept callb
6820: 61 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b ack error} {sock
6830: 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 et stdio} {.
6840: 23 20 54 68 65 72 65 20 69 73 20 61 20 64 65 62 # There is a deb
6850: 75 67 20 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 ug assertion on
6860: 57 69 6e 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 Windows/SSL that
6870: 20 63 61 75 73 65 73 20 61 20 63 72 61 73 68 20 causes a crash
6880: 77 68 65 6e 20 74 68 65 0a 20 20 20 20 23 20 63 when the. # c
6890: 65 72 74 69 66 69 63 61 74 65 20 69 73 6e 27 74 ertificate isn't
68a0: 20 73 70 65 63 69 66 69 65 64 2e 0a 20 20 20 20 specified..
68b0: 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 removeFile scrip
68c0: 74 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 t. set f [ope
68d0: 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 n script w].
68e0: 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 puts $f [list se
68f0: 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 t auto_path $aut
6900: 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 o_path]. puts
6910: 20 24 66 20 7b 0a 20 20 20 20 09 70 61 63 6b 61 $f {. .packa
6920: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 ge require tls..
6930: 67 65 74 73 20 73 74 64 69 6e 0a 20 20 20 20 7d gets stdin. }
6940: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
6950: 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d st tls::socket -
6960: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 31 cafile $caCert 1
6970: 32 37 2e 30 2e 30 2e 31 20 38 38 34 38 5d 0a 20 27.0.0.1 8848].
6980: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6990: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
69a0: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
69b0: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
69c0: 20 72 2b 5d 0a 20 20 20 20 70 72 6f 63 20 62 67 r+]. proc bg
69d0: 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c error args {..gl
69e0: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 obal x..set x $a
69f0: 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 rgs. }. pr
6a00: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
6a10: 7d 20 7b 65 78 70 72 20 31 30 20 2f 20 30 7d 0a } {expr 10 / 0}.
6a20: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
6a30: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
6a40: 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 ccept \.. -ce
6a50: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
6a60: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
6a70: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
6a80: 76 65 72 4b 65 79 20 38 38 34 38 5d 0a 20 20 20 verKey 8848].
6a90: 20 70 75 74 73 20 24 66 20 68 65 6c 6c 6f 0a 20 puts $f hello.
6aa0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
6ab0: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
6ac0: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
6ad0: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
6ae0: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
6af0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
6b00: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 close $s. r
6b10: 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d ename bgerror {}
6b20: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 . set x.} {{d
6b30: 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a ivide by zero}}.
6b40: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 31 20 .test tlsIO-7.1
6b50: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
6b60: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
6b70: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
6b80: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
6b90: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
6ba0: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
6bb0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
6bc0: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
6bd0: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
6be0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
6bf0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
6c00: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
6c10: 20 24 66 20 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 $f [list tls::s
6c20: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
6c30: 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cept \.. -cer
6c40: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
6c50: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
6c60: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
6c70: 65 72 4b 65 79 20 38 38 32 30 5d 0a 20 20 20 20 erKey 8820].
6c80: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
6c90: 61 63 63 65 70 74 20 61 72 67 73 20 7b 0a 09 20 accept args {..
6ca0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 global x..
6cb0: 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 set x done..}..
6cc0: 70 75 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 puts ready..set
6cd0: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
6ce0: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
6cf0: 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 78 0a 09 out"]..vwait x..
6d00: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
6d10: 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c mer. }. cl
6d20: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 66 ose $f. set f
6d30: 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 [open "|[list $
6d40: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
6d50: 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 st script]" r].
6d60: 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 20 73 gets $f. s
6d70: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
6d80: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
6d90: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
6da0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
6db0: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
6dc0: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
6dd0: 30 2e 31 20 38 38 32 30 5d 0a 20 20 20 20 73 65 0.1 8820]. se
6de0: 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t p [fconfigure
6df0: 24 73 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 $s -peername].
6e00: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
6e10: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
6e20: 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 65 6e 64 l "". lappend
6e30: 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f 6d 70 61 l [string compa
6e40: 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d re [lindex $p 0]
6e50: 20 31 32 37 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 127.0.0.1].
6e60: 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 72 69 6e lappend l [strin
6e70: 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e 64 65 g compare [linde
6e80: 78 20 24 70 20 32 5d 20 38 38 32 30 5d 0a 20 20 x $p 2] 8820].
6e90: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 lappend l [lle
6ea0: 6e 67 74 68 20 24 70 5d 0a 7d 20 7b 30 20 30 20 ngth $p].} {0 0
6eb0: 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 3}..test tlsIO-7
6ec0: 2e 32 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b .2 {testing sock
6ed0: 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 et specific opti
6ee0: 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 ons} {socket std
6ef0: 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 io} {. remove
6f00: 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 File script.
6f10: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
6f20: 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 pt w]. puts $
6f30: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
6f40: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
6f50: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
6f60: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
6f70: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
6f80: 75 74 73 20 24 66 20 22 74 6c 73 3a 3a 73 6f 63 uts $f "tls::soc
6f90: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
6fa0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
6fb0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
6fc0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
6fd0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 e $serverKey 882
6fe0: 31 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 1". puts $f {
6ff0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 61 72 ..proc accept ar
7000: 67 73 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c gs {.. global
7010: 20 78 0a 09 20 20 20 20 73 65 74 20 78 20 64 6f x.. set x do
7020: 6e 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 ne..}..puts read
7030: 79 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 y..set timer [af
7040: 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 78 ter 10000 "set x
7050: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 09 76 77 timed_out"]..vw
7060: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
7070: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 7d cel $timer. }
7080: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
7090: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c set f [open "|
70a0: 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 [list $::tcltest
70b0: 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 ::tcltest script
70c0: 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 ]" r]. gets $
70d0: 66 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 f. set s [tls
70e0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
70f0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
7100: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
7110: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
7120: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
7130: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 31 5d 127.0.0.1 8821]
7140: 0a 20 20 20 20 73 65 74 20 70 20 5b 66 63 6f 6e . set p [fcon
7150: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e figure $s -sockn
7160: 61 6d 65 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 ame]. close $
7170: 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 s. close $f.
7180: 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 set l "".
7190: 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 lappend l [lleng
71a0: 74 68 20 24 70 5d 0a 20 20 20 20 6c 61 70 70 65 th $p]. lappe
71b0: 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 24 70 20 nd l [lindex $p
71c0: 30 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 0]. lappend l
71d0: 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20 5b [string equal [
71e0: 6c 69 6e 64 65 78 20 24 70 20 32 5d 20 38 38 32 lindex $p 2] 882
71f0: 31 5d 0a 7d 20 7b 33 20 31 32 37 2e 30 2e 30 2e 1].} {3 127.0.0.
7200: 31 20 30 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 1 0}..test tlsIO
7210: 2d 37 2e 33 20 7b 74 65 73 74 69 6e 67 20 73 6f -7.3 {testing so
7220: 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f 70 cket specific op
7230: 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 tions} {socket}
7240: 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 {. set s [tls
7250: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 ::socket \..-cer
7260: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
7270: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7280: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
7290: 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 erKey \. .-se
72a0: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 32 rver accept 8822
72b0: 5d 0a 20 20 20 20 73 65 74 20 6c 20 5b 6c 6c 65 ]. set l [lle
72c0: 6e 67 74 68 20 5b 66 63 6f 6e 66 69 67 75 72 65 ngth [fconfigure
72d0: 20 24 73 5d 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s]]. close
72e0: 24 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 20 $s. update.
72f0: 20 20 23 20 41 20 62 75 67 20 66 69 78 65 64 20 # A bug fixed
7300: 69 6e 20 66 63 6f 6e 66 69 67 75 72 65 20 66 6f in fconfigure fo
7310: 72 20 38 2e 33 2e 34 2b 20 6d 61 6b 65 20 74 68 r 8.3.4+ make th
7320: 69 73 20 72 65 74 75 72 6e 20 31 34 20 6e 6f 72 is return 14 nor
7330: 6d 61 6c 6c 79 2c 0a 20 20 20 20 23 20 62 75 74 mally,. # but
7340: 20 31 32 20 69 6e 20 6f 6c 64 65 72 20 76 65 72 12 in older ver
7350: 73 69 6f 6e 73 2e 0a 20 20 20 20 65 78 70 72 20 sions.. expr
7360: 7b 24 6c 20 3e 3d 20 31 32 20 26 26 20 28 28 24 {$l >= 12 && (($
7370: 6c 20 25 20 32 29 20 3d 3d 20 30 29 7d 0a 7d 20 l % 2) == 0)}.}
7380: 31 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 1..# bug report
7390: 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 #5812 fconfigure
73a0: 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 doesn't return
73b0: 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b value for '-sock
73c0: 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 name'..test tlsI
73d0: 4f 2d 37 2e 34 20 7b 74 65 73 74 69 6e 67 20 73 O-7.4 {testing s
73e0: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
73f0: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d ptions} {socket}
7400: 20 7b 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c {. set s [tl
7410: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 s::socket \..-ce
7420: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
7430: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
7440: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
7450: 76 65 72 4b 65 79 20 5c 0a 20 20 20 20 09 2d 73 verKey \. .-s
7460: 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 32 erver accept 882
7470: 33 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 3]. proc acce
7480: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c pt {s a p} {..gl
7490: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 obal x..set x [f
74a0: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 73 6f configure $s -so
74b0: 63 6b 6e 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 ckname]..close $
74c0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
74d0: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
74e0: 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c \..-certfile $cl
74f0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
7500: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
7510: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 e $clientKey \.
7520: 20 20 20 09 6c 6f 63 61 6c 68 6f 73 74 20 38 38 .localhost 88
7530: 32 33 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 23]. set time
7540: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
7550: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
7560: 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 ]. vwait x.
7570: 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 after cancel $
7580: 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 timer. close
7590: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
75a0: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
75b0: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e lappend l [lin
75c0: 64 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 dex $x 2] [lleng
75d0: 74 68 20 24 78 5d 0a 7d 20 7b 38 38 32 33 20 33 th $x].} {8823 3
75e0: 7d 0a 0a 23 20 62 75 67 20 72 65 70 6f 72 74 20 }..# bug report
75f0: 23 35 38 31 32 20 66 63 6f 6e 66 69 67 75 72 65 #5812 fconfigure
7600: 20 64 6f 65 73 6e 27 74 20 72 65 74 75 72 6e 20 doesn't return
7610: 76 61 6c 75 65 20 66 6f 72 20 27 2d 73 6f 63 6b value for '-sock
7620: 6e 61 6d 65 27 0a 0a 74 65 73 74 20 74 6c 73 49 name'..test tlsI
7630: 4f 2d 37 2e 35 20 7b 74 65 73 74 69 6e 67 20 73 O-7.5 {testing s
7640: 6f 63 6b 65 74 20 73 70 65 63 69 66 69 63 20 6f ocket specific o
7650: 70 74 69 6f 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 ptions} {socket
7660: 75 6e 69 78 4f 72 50 63 7d 20 7b 0a 20 20 20 20 unixOrPc} {.
7670: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
7680: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
7690: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
76a0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
76b0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
76c0: 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 Key \.. -serv
76d0: 65 72 20 61 63 63 65 70 74 20 38 38 32 39 5d 0a er accept 8829].
76e0: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
76f0: 7b 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 {s a p} {..globa
7700: 6c 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e l x..set x [fcon
7710: 66 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e figure $s -sockn
7720: 61 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 ame]..close $s.
7730: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 }. set s1
7740: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
7750: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
7760: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
7770: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
7780: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
7790: 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
77a0: 38 32 39 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 829]. set tim
77b0: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
77c0: 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 "set x timed_out
77d0: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 "]. vwait x.
77e0: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
77f0: 24 74 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 $timer. close
7800: 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s. close $s
7810: 31 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 1. set l "".
7820: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 lappend l [li
7830: 6e 64 65 78 20 24 78 20 30 5d 20 5b 6c 69 6e 64 ndex $x 0] [lind
7840: 65 78 20 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 ex $x 2] [llengt
7850: 68 20 24 78 5d 0a 7d 20 7b 31 32 37 2e 30 2e 30 h $x].} {127.0.0
7860: 2e 31 20 38 38 32 39 20 33 7d 0a 0a 74 65 73 74 .1 8829 3}..test
7870: 20 74 6c 73 49 4f 2d 38 2e 31 20 7b 74 65 73 74 tlsIO-8.1 {test
7880: 69 6e 67 20 2d 61 73 79 6e 63 20 66 6c 61 67 20 ing -async flag
7890: 6f 6e 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 on sockets} {soc
78a0: 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 4e 4f 54 ket} {. # NOT
78b0: 45 3a 20 54 68 69 73 20 74 65 73 74 20 6d 61 79 E: This test may
78c0: 20 66 61 69 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f fail on some So
78d0: 6c 61 72 69 73 20 32 2e 34 20 73 79 73 74 65 6d laris 2.4 system
78e0: 73 2e 0a 20 20 20 20 23 20 53 65 65 20 6e 6f 74 s.. # See not
78f0: 65 73 20 69 6e 20 54 63 6c 27 73 20 73 6f 63 6b es in Tcl's sock
7900: 65 74 2e 74 65 73 74 2e 0a 20 20 20 20 73 65 74 et.test.. set
7910: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
7920: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
7930: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
7940: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7950: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
7960: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
7970: 61 63 63 65 70 74 20 38 38 33 30 5d 0a 20 20 20 accept 8830].
7980: 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 proc accept {s
7990: 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 a p} {..global x
79a0: 0a 09 23 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 ..# when doing a
79b0: 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 n in-process cli
79c0: 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c ent/server test,
79d0: 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 both sides need
79e0: 0a 09 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c ..# to be non-bl
79f0: 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 ocking for the T
7a00: 4c 53 20 68 61 6e 64 73 68 61 6b 65 2e 20 20 41 LS handshake. A
7a10: 6c 73 6f 20 6d 61 6b 65 20 73 75 72 65 0a 09 23 lso make sure..#
7a20: 20 74 6f 20 72 65 74 75 72 6e 20 74 68 65 20 63 to return the c
7a30: 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 6e 65 20 62 hannel to line b
7a40: 75 66 66 65 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 uffering mode...
7a50: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
7a60: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
7a70: 72 69 6e 67 20 6c 69 6e 65 0a 09 70 75 74 73 20 ring line..puts
7a80: 24 73 20 62 79 65 0a 09 23 20 4f 6e 6c 79 20 4f $s bye..# Only O
7a90: 70 65 6e 53 53 4c 20 30 2e 39 2e 35 61 20 6f 6e penSSL 0.9.5a on
7aa0: 20 57 69 6e 64 6f 77 73 20 73 65 65 6d 73 20 74 Windows seems t
7ab0: 6f 20 6e 65 65 64 20 74 68 65 20 61 66 74 65 72 o need the after
7ac0: 20 28 64 65 6c 61 79 65 64 29 0a 09 23 20 63 6c (delayed)..# cl
7ad0: 6f 73 65 2c 20 62 75 74 20 69 74 20 77 6f 72 6b ose, but it work
7ae0: 73 20 6a 75 73 74 20 74 68 65 20 73 61 6d 65 20 s just the same
7af0: 66 6f 72 20 61 6c 6c 20 6f 74 68 65 72 73 2e 20 for all others.
7b00: 2d 68 6f 62 62 73 0a 09 61 66 74 65 72 20 35 30 -hobbs..after 50
7b10: 30 20 63 6c 6f 73 65 20 24 73 0a 09 73 65 74 20 0 close $s..set
7b20: 78 20 64 6f 6e 65 0a 20 20 20 20 7d 0a 20 20 20 x done. }.
7b30: 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f set s1 [tls::so
7b40: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
7b50: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
7b60: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7b70: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
7b80: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 61 73 ntKey \.. -as
7b90: 79 6e 63 20 6c 6f 63 61 6c 68 6f 73 74 20 38 38 ync localhost 88
7ba0: 33 30 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 64 30]. # when d
7bb0: 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 oing an in-proce
7bc0: 73 73 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 ss client/server
7bd0: 20 74 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 test, both side
7be0: 73 20 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 s need. # to
7bf0: 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 be non-blocking
7c00: 66 6f 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 for the TLS hand
7c10: 73 68 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b 65 shake Also make
7c20: 20 73 75 72 65 20 74 6f 0a 20 20 20 20 23 20 72 sure to. # r
7c30: 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 eturn the channe
7c40: 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 l to line buffer
7c50: 69 6e 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 65 ing mode (TLS se
7c60: 74 73 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 29 ts it to 'none')
7c70: 2e 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
7c80: 20 24 73 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 $s1 -blocking 0
7c90: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
7ca0: 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 . vwait x.
7cb0: 20 23 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 69 # TLS handshaki
7cc0: 6e 67 20 6e 65 65 64 73 20 6f 6e 65 20 62 79 74 ng needs one byt
7cd0: 65 20 66 72 6f 6d 20 74 68 65 20 63 6c 69 65 6e e from the clien
7ce0: 74 2e 2e 2e 0a 20 20 20 20 70 75 74 73 20 24 73 t.... puts $s
7cf0: 31 20 61 0a 20 20 20 20 23 20 6e 65 65 64 20 75 1 a. # need u
7d00: 70 64 61 74 65 20 74 6f 20 63 6f 6d 70 6c 65 74 pdate to complet
7d10: 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 e TLS handshake
7d20: 69 6e 2d 70 72 6f 63 65 73 73 0a 20 20 20 20 75 in-process. u
7d30: 70 64 61 74 65 0a 20 20 20 20 66 63 6f 6e 66 69 pdate. fconfi
7d40: 67 75 72 65 20 24 73 31 20 2d 62 6c 6f 63 6b 69 gure $s1 -blocki
7d50: 6e 67 20 31 0a 20 20 20 20 73 65 74 20 7a 20 5b ng 1. set z [
7d60: 67 65 74 73 20 24 73 31 5d 0a 20 20 20 20 63 6c gets $s1]. cl
7d70: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
7d80: 20 24 73 31 0a 20 20 20 20 73 65 74 20 7a 0a 7d $s1. set z.}
7d90: 20 62 79 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f bye..test tlsIO
7da0: 2d 39 2e 31 20 7b 74 65 73 74 69 6e 67 20 73 70 -9.1 {testing sp
7db0: 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d 20 7b urious events} {
7dc0: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 socket} {. se
7dd0: 74 20 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 t len 0. set
7de0: 73 70 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 spurious 0. s
7df0: 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 et done 0. pr
7e00: 6f 63 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 oc readlittle {s
7e10: 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 } {..global spur
7e20: 69 6f 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 ious done len..s
7e30: 65 74 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d et l [read $s 1]
7e40: 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 ..if {[string le
7e50: 6e 67 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b ngth $l] == 0} {
7e60: 0a 09 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 .. if {![eof
7e70: 24 73 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 $s]} {...incr sp
7e80: 75 72 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c urious.. } el
7e90: 73 65 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a se {...close $s.
7ea0: 09 09 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 ..set done 1..
7eb0: 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 }..} else {..
7ec0: 20 20 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 incr len [str
7ed0: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 ing length $l]..
7ee0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
7ef0: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
7f00: 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 {..fconfigure $s
7f10: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 -blocking 0..fi
7f20: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
7f30: 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e ble [list do_han
7f40: 64 73 68 61 6b 65 20 24 73 20 72 65 61 64 61 62 dshake $s readab
7f50: 6c 65 20 72 65 61 64 6c 69 74 74 6c 65 20 5c 0a le readlittle \.
7f60: 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e ..-buffering non
7f70: 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 e]. }. set
7f80: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
7f90: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
7fa0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
7fb0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
7fc0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
7fd0: 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 \.. -server
7fe0: 61 63 63 65 70 74 20 38 38 33 31 5d 0a 20 20 20 accept 8831].
7ff0: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
8000: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
8010: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
8020: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8030: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
8040: 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 tKey \.. loca
8050: 6c 68 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 20 lhost 8831].
8060: 23 20 54 68 69 73 20 64 69 66 66 65 72 73 20 66 # This differs f
8070: 72 6f 6d 20 73 6f 63 6b 65 74 2d 39 2e 31 20 69 rom socket-9.1 i
8080: 6e 20 74 68 61 74 20 62 6f 74 68 20 73 69 64 65 n that both side
8090: 73 20 6e 65 65 64 20 74 6f 20 62 65 0a 20 20 20 s need to be.
80a0: 20 23 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 # non-blocking
80b0: 62 65 63 61 75 73 65 20 6f 66 20 54 4c 53 27 20 because of TLS'
80c0: 72 65 71 75 69 72 65 64 20 68 61 6e 64 73 68 61 required handsha
80d0: 6b 65 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ke. fconfigur
80e0: 65 20 24 63 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 e $c -blocking 0
80f0: 0a 20 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 . puts -nonew
8100: 6c 69 6e 65 20 24 63 20 30 31 32 33 34 35 36 37 line $c 01234567
8110: 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 8901234567890123
8120: 34 35 36 37 38 39 30 31 32 33 34 35 36 37 38 39 4567890123456789
8130: 30 31 32 33 34 35 36 37 38 39 0a 20 20 20 20 63 0123456789. c
8140: 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 lose $c. set
8150: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
8160: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
8170: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
8180: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
8190: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
81a0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
81b0: 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 list $spurious
81c0: 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 $len.} {0 50}..t
81d0: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 est tlsIO-9.2 {t
81e0: 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 72 69 esting async wri
81f0: 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 2c 20 te, fileevents,
8200: 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 flush on close}
8210: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 {socket} {. s
8220: 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 et firstblock [s
8230: 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 tring repeat a 3
8240: 31 5d 0a 20 20 20 20 73 65 74 20 73 65 63 6f 6e 1]. set secon
8250: 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 dblock [string r
8260: 65 70 65 61 74 20 62 20 36 35 35 33 35 5d 0a 20 epeat b 65535].
8270: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
8280: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
8290: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
82a0: 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 g 0..fileevent $
82b0: 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 s readable [list
82c0: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 do_handshake $s
82d0: 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 61 62 readable readab
82e0: 6c 65 20 5c 0a 09 09 2d 74 72 61 6e 73 6c 61 74 le \...-translat
82f0: 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 ion lf -buffersi
8300: 7a 65 20 31 36 33 38 34 20 2d 62 75 66 66 65 72 ze 16384 -buffer
8310: 69 6e 67 20 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a ing line]. }.
8320: 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 62 6c proc readabl
8330: 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c 20 5b e {s} {..set l [
8340: 67 65 74 73 20 24 73 5d 0a 09 64 70 75 74 73 20 gets $s]..dputs
8350: 22 67 6f 74 20 5c 22 5b 73 74 72 69 6e 67 20 72 "got \"[string r
8360: 65 70 6c 61 63 65 20 24 6c 20 31 30 20 65 6e 64 eplace $l 10 end
8370: 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b -3 ...]\" \...([
8380: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
8390: 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 66 69 6c ]) from $s"..fil
83a0: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
83b0: 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 30 30 le {}..after 100
83c0: 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 20 20 0 respond $s.
83d0: 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 73 70 }. proc resp
83e0: 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 ond {s} {..globa
83f0: 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 64 70 l firstblock..dp
8400: 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 uts "send \"[str
8410: 69 6e 67 20 72 65 70 6c 61 63 65 20 24 66 69 72 ing replace $fir
8420: 73 74 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 stblock 10 end-3
8430: 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 ...]\" \...([st
8440: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 66 69 72 ring length $fir
8450: 73 74 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 stblock]) down $
8460: 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c s"..puts -nonewl
8470: 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 6c 6f ine $s $firstblo
8480: 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 20 77 ck..after 1000 w
8490: 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 20 20 ritedata $s.
84a0: 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 }. proc write
84b0: 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 data {s} {..glob
84c0: 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 al secondblock..
84d0: 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 dputs "send \"[s
84e0: 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 73 tring replace $s
84f0: 65 63 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 65 6e econdblock 10 en
8500: 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 d-3 ...]\" \...(
8510: 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 [string length $
8520: 73 65 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f secondblock]) do
8530: 77 6e 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f wn $s"..puts -no
8540: 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 63 6f newline $s $seco
8550: 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 ndblock..close $
8560: 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 s. }. set
8570: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
8580: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8590: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
85a0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
85b0: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
85c0: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
85d0: 63 63 65 70 74 20 38 38 33 32 5d 0a 20 20 20 20 ccept 8832].
85e0: 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b set c [tls::sock
85f0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
8600: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
8610: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
8620: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
8630: 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c Key \.. local
8640: 68 6f 73 74 20 38 38 33 32 5d 0a 20 20 20 20 66 host 8832]. f
8650: 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c configure $c -bl
8660: 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 20 ocking 0 -trans
8670: 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 lf -buffering li
8680: 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ne. set count
8690: 20 30 0a 20 20 20 20 70 75 74 73 20 24 63 20 68 0. puts $c h
86a0: 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 72 65 ello. proc re
86b0: 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 adit {s} {..glob
86c0: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 al count done..s
86d0: 65 74 20 64 61 74 61 20 5b 72 65 61 64 20 24 73 et data [read $s
86e0: 5d 0a 09 64 70 75 74 73 20 22 72 65 61 64 20 5c ]..dputs "read \
86f0: 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 "[string replace
8700: 20 24 64 61 74 61 20 31 30 20 65 6e 64 2d 33 20 $data 10 end-3
8710: 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 ...]\" \...([str
8720: 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 61 74 61 ing length $data
8730: 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 69 6e 63 ]) from $s"..inc
8740: 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e 67 20 r count [string
8750: 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 0a 09 69 length $data]..i
8760: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
8770: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 20 close $s..
8780: 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d 0a set done 1..}.
8790: 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 65 76 }. fileev
87a0: 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 20 ent $c readable
87b0: 22 72 65 61 64 69 74 20 24 63 22 0a 20 20 20 20 "readit $c".
87c0: 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 73 set done 0. s
87d0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
87e0: 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 10000 "set done
87f0: 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 timed_out"].
8800: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 vwait done. a
8810: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
8820: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a er. close $s.
8830: 20 20 20 20 6c 69 73 74 20 24 63 6f 75 6e 74 20 list $count
8840: 24 64 6f 6e 65 0a 7d 20 7b 36 35 35 36 36 20 31 $done.} {65566 1
8850: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e }..test tlsIO-9.
8860: 33 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 3 {testing EOF s
8870: 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 tickyness} {unex
8880: 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 plainedFailure s
8890: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 48 ocket} {. # H
88a0: 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 6f 72 6b OBBS: never work
88b0: 65 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 20 20 ed correctly.
88c0: 20 70 72 6f 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 proc count_to_e
88d0: 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c of {s} {..global
88e0: 20 63 6f 75 6e 74 20 64 6f 6e 65 20 74 69 6d 65 count done time
88f0: 72 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 20 24 r..set l [gets $
8900: 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d s]..if {[eof $s]
8910: 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 63 6f } {.. incr co
8920: 75 6e 74 0a 09 20 20 20 20 69 66 20 7b 24 63 6f unt.. if {$co
8930: 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f unt > 9} {...clo
8940: 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f 6e 65 se $s...set done
8950: 20 74 72 75 65 0a 09 09 73 65 74 20 63 6f 75 6e true...set coun
8960: 74 20 7b 65 6f 66 20 69 73 20 73 74 69 63 6b 79 t {eof is sticky
8970: 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c }...after cancel
8980: 20 24 74 69 6d 65 72 0a 09 20 20 20 20 7d 0a 09 $timer.. }..
8990: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
89a0: 20 74 69 6d 65 72 70 72 6f 63 20 7b 7d 20 7b 0a timerproc {} {.
89b0: 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 6f 75 .global done cou
89c0: 6e 74 20 63 0a 09 73 65 74 20 64 6f 6e 65 20 74 nt c..set done t
89d0: 72 75 65 0a 09 73 65 74 20 63 6f 75 6e 74 20 7b rue..set count {
89e0: 74 69 6d 65 72 20 77 65 6e 74 20 6f 66 66 2c 20 timer went off,
89f0: 65 6f 66 20 69 73 20 6e 6f 74 20 73 74 69 63 6b eof is not stick
8a00: 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 20 20 y}..close $c.
8a10: 20 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 }. set count
8a20: 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 0. set done
8a30: 66 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 20 77 false. proc w
8a40: 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 rite_then_close
8a50: 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 20 62 {s} {..puts $s b
8a60: 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 ye..close $s.
8a70: 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 }. proc acce
8a80: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 pt {s a p} {..fc
8a90: 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f onfigure $s -blo
8aa0: 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 cking 0 -bufferi
8ab0: 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 ng line -transla
8ac0: 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 76 65 tion lf..fileeve
8ad0: 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 20 5b nt $s writable [
8ae0: 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b list do_handshak
8af0: 65 20 24 73 20 77 72 69 74 61 62 6c 65 20 77 72 e $s writable wr
8b00: 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 5c ite_then_close \
8b10: 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 ...-buffering li
8b20: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
8b30: 6c 66 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 lf]. }. se
8b40: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
8b50: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
8b60: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
8b70: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8b80: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
8b90: 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 y \.. -server
8ba0: 20 61 63 63 65 70 74 20 38 38 33 33 5d 0a 20 20 accept 8833].
8bb0: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
8bc0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
8bd0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
8be0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8bf0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
8c00: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 ntKey \.. loc
8c10: 61 6c 68 6f 73 74 20 38 38 33 33 5d 0a 20 20 20 alhost 8833].
8c20: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d fconfigure $c -
8c30: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 blocking 0 -buff
8c40: 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e ering line -tran
8c50: 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 20 66 slation lf. f
8c60: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
8c70: 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 able "count_to_e
8c80: 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 20 74 of $c". set t
8c90: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
8ca0: 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 20 20 timerproc].
8cb0: 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 63 vwait done. c
8cc0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 20 lose $s. set
8cd0: 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 73 20 count.} {eof is
8ce0: 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 sticky}..removeF
8cf0: 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 73 74 ile script..test
8d00: 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 65 73 tlsIO-10.1 {tes
8d10: 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 63 65 ting socket acce
8d20: 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 72 6f pt callback erro
8d30: 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 r handling} {soc
8d40: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 67 ket} {. set g
8d50: 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 70 72 oterror 0. pr
8d60: 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 73 20 oc bgerror args
8d70: 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 6f 72 {global goterror
8d80: 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 20 31 ; set goterror 1
8d90: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
8da0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 ::socket -cafile
8db0: 20 24 63 61 43 65 72 74 20 2d 73 65 72 76 65 72 $caCert -server
8dc0: 20 61 63 63 65 70 74 20 38 38 39 38 5d 0a 20 20 accept 8898].
8dd0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
8de0: 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 73 3b a p} {close $s;
8df0: 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 74 20 error}. set
8e00: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d c [tls::socket -
8e10: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 31 cafile $caCert 1
8e20: 32 37 2e 30 2e 30 2e 31 20 38 38 39 38 5d 0a 20 27.0.0.1 8898].
8e30: 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 72 6f vwait goterro
8e40: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
8e50: 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 close $c.
8e60: 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d 20 31 set goterror.} 1
8e70: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
8e80: 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 1 {tcp connectio
8e90: 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 n} {socket doTes
8ea0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
8eb0: 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 er} {. sendCe
8ec0: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
8ed0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
8ee0: 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 socket9_1_test_s
8ef0: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
8f00: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
8f10: 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 t \...-certfile
8f20: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
8f30: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8f40: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
8f50: 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 63 65 8834]..proc acce
8f60: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
8f70: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
8f80: 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 24 73 $s.. puts $s
8f90: 20 64 6f 6e 65 0a 09 20 20 20 20 63 6c 6f 73 65 done.. close
8fa0: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
8fb0: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
8fc0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
8fd0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
8fe0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8ff0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
9000: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
9010: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 34 oteServerIP 8834
9020: 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 ]. set r [get
9030: 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $s]. close
9040: 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 $s. sendComma
9050: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
9060: 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_1_test_server
9070: 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 64 6f }. set r.} do
9080: 6e 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 ne..test tlsIO-1
9090: 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 65 63 1.2 {client spec
90a0: 69 66 69 65 73 20 69 74 73 20 70 6f 72 74 7d 20 ifies its port}
90b0: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
90c0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
90d0: 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f {. if {[info
90e0: 20 65 78 69 73 74 73 20 70 6f 72 74 5d 7d 20 7b exists port]} {
90f0: 0a 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 20 20 ..incr port.
9100: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 70 6f } else {..set po
9110: 72 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 53 65 rt [expr {$tlsSe
9120: 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 64 5d rverPort + [pid]
9130: 25 31 30 32 34 7d 5d 0a 20 20 20 20 7d 0a 20 20 %1024}]. }.
9140: 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 sendCertValues
9150: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
9160: 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 39 5f {..set socket9_
9170: 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 5b 74 2_test_server [t
9180: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
9190: 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 2d 63 er accept \...-c
91a0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
91b0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
91c0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
91d0: 72 76 65 72 4b 65 79 20 38 38 33 35 5d 0a 09 70 rverKey 8835]..p
91e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
91f0: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
9200: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
9210: 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 20 20 puts $s $p..
9220: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
9230: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
9240: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9250: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
9260: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
9270: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9280: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
9290: 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 20 -myport $port
92a0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
92b0: 38 38 33 35 5d 0a 20 20 20 20 73 65 74 20 72 20 8835]. set r
92c0: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c [gets $s]. cl
92d0: 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 ose $s. sendC
92e0: 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 ommand {close $s
92f0: 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f 73 65 ocket9_2_test_se
9300: 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b 24 72 rver}. if {$r
9310: 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 73 65 == $port} {..se
9320: 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 20 20 t result ok.
9330: 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 } else {..set re
9340: 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 20 20 sult broken.
9350: 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 }. set result
9360: 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 49 .} ok..test tlsI
9370: 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 20 74 O-11.3 {trying t
9380: 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 o connect, no se
9390: 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 64 6f rver} {socket do
93a0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
93b0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 74 erver} {. set
93c0: 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 20 69 status ok. i
93d0: 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 74 20 f {![catch {set
93e0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
93f0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
9400: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
9410: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
9420: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
9430: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
9440: 72 76 65 72 49 70 20 38 38 33 36 5d 7d 5d 7d 20 rverIp 8836]}]}
9450: 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b {..if {![catch {
9460: 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 gets $s}]} {..
9470: 20 20 73 65 74 20 73 74 61 74 75 73 20 62 72 6f set status bro
9480: 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 24 73 ken..}..close $s
9490: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
94a0: 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 tatus.} ok..test
94b0: 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 65 6d tlsIO-11.4 {rem
94c0: 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 ote echo, one li
94d0: 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ne} {socket doTe
94e0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
94f0: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
9500: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
9510: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
9520: 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 socket10_6_test
9530: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
9540: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
9550: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
9560: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9570: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
9580: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
9590: 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f ccept 8836]..pro
95a0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
95b0: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
95c0: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 dshake $s.. f
95d0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
95e0: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
95f0: 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 $s].. fconfig
9600: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
9610: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
9620: 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f ion crlf..}..pro
9630: 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 c echo {s} {..
9640: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
9650: 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 ].. if {[eof
9660: 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 $s]} {...close $
9670: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
9680: 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 ..puts $s $l..
9690: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 }..}. }.
96a0: 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 set f [tls::soc
96b0: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
96c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
96d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
96e0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
96f0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
9700: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
9710: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
9720: 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e $f -translation
9730: 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 crlf -buffering
9740: 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 20 24 line. puts $
9750: 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 74 20 f hello. set
9760: 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 r [gets $f].
9770: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e close $f. sen
9780: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
9790: 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 73 74 $socket10_6_test
97a0: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
97b0: 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 73 74 r.} hello..test
97c0: 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 65 6d tlsIO-11.5 {rem
97d0: 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c 69 6e ote echo, 50 lin
97e0: 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 es} {socket doTe
97f0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
9800: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
9810: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
9820: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
9830: 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 socket10_7_test
9840: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
9850: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
9860: 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ept \...-certfil
9870: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
9880: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9890: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
98a0: 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 y 8836]..proc ac
98b0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
98c0: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
98d0: 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 ke $s.. filee
98e0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
98f0: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
9900: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9910: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
9920: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
9930: 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 crlf..}..proc ec
9940: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 ho {s} {.. se
9950: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 t l [gets $s]..
9960: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
9970: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 {...close $s..
9980: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 } else {...pu
9990: 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a ts $s $l.. }.
99a0: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
99b0: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
99c0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
99d0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
99e0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
99f0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9a00: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9a10: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
9a20: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 fconfigure $f
9a30: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
9a40: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
9a50: 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 63 e. for {set c
9a60: 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 35 30 nt 0} {$cnt < 50
9a70: 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 } {incr cnt} {..
9a80: 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f 2c 20 puts $f "hello,
9a90: 24 63 6e 74 22 0a 09 69 66 20 7b 5b 67 65 74 73 $cnt"..if {[gets
9aa0: 20 24 66 5d 20 6e 65 20 22 68 65 6c 6c 6f 2c 20 $f] ne "hello,
9ab0: 24 63 6e 74 22 7d 20 7b 0a 09 20 20 20 20 62 72 $cnt"} {.. br
9ac0: 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 eak..}. }.
9ad0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
9ae0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
9af0: 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 $socket10_7_tes
9b00: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
9b10: 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 t cnt.} 50..# Ma
9b20: 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 cintosh sockets
9b30: 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 can have more th
9b40: 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 an one server pe
9b50: 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f r port.if {$tcl_
9b60: 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 platform(platfor
9b70: 6d 29 20 65 71 20 22 6d 61 63 69 6e 74 6f 73 68 m) eq "macintosh
9b80: 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e "} {. set con
9b90: 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 30 20 38 flictResult {0 8
9ba0: 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 836}.} else {.
9bb0: 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 set conflictRe
9bc0: 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 sult {1 {couldn'
9bd0: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 t open socket: a
9be0: 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 ddress already i
9bf0: 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 n use}}.}..test
9c00: 74 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b tlsIO-11.6 {sock
9c10: 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f et conflict} {so
9c20: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
9c30: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
9c40: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
9c50: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
9c60: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
9c70: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9c80: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
9c90: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
9ca0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
9cb0: 38 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 836]. if {[ca
9cc0: 74 63 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 tch {set s2 [tls
9cd0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
9ce0: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
9cf0: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
9d00: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9d10: 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 serverKey \..
9d20: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
9d30: 38 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 8836]} msg]} {..
9d40: 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 set result [list
9d50: 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 1 $msg]. } e
9d60: 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c lse {..set resul
9d70: 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 t [list 0 [linde
9d80: 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 x [fconfigure $s
9d90: 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 2 -sockname] 2]]
9da0: 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 ..close $s2.
9db0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a }. close $s1.
9dc0: 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d set result.}
9dd0: 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 $conflictResult
9de0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
9df0: 37 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 7 {server with s
9e00: 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 everal clients}
9e10: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
9e20: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
9e30: 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 {. sendCertV
9e40: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
9e50: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
9e60: 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 ket10_9_test_ser
9e70: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
9e80: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
9e90: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
9ea0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
9eb0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
9ec0: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
9ed0: 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 8836]..proc ac
9ee0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
9ef0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
9f00: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
9f10: 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 e.. fileevent
9f20: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
9f30: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 st echo $s]..}..
9f40: 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a proc echo {s} {.
9f50: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
9f60: 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 $s].. if {[e
9f70: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 of $s]} {...clos
9f80: 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 e $s.. } else
9f90: 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a {...puts $s $l.
9fa0: 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a . }..}. }.
9fb0: 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a set s1 [tls:
9fc0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
9fd0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
9fe0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9ff0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
a000: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
a010: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
a020: 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8836]. fconfi
a030: 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 gure $s1 -buffer
a040: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 ing line. set
a050: 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s2 [tls::socket
a060: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
a070: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
a080: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
a090: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
a0a0: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
a0b0: 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 ServerIP 8836].
a0c0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
a0d0: 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 2 -buffering lin
a0e0: 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c e. set s3 [tl
a0f0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
a100: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
a110: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
a120: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a130: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
a140: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
a150: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e P 8836]. fcon
a160: 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 figure $s3 -buff
a170: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 ering line. f
a180: 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 or {set i 0} {$i
a190: 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d < 100} {incr i}
a1a0: 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c {..puts $s1 hel
a1b0: 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 31 lo,tlsIO-11.7,s1
a1c0: 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 ..gets $s1..puts
a1d0: 20 24 73 32 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f $s2 hello,tlsIO
a1e0: 2d 31 31 2e 37 2c 73 32 0a 09 67 65 74 73 20 24 -11.7,s2..gets $
a1f0: 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c s2..puts $s3 hel
a200: 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 33 lo,tlsIO-11.7,s3
a210: 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d ..gets $s3. }
a220: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
a230: 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 close $s2.
a240: 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 close $s3. s
a250: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
a260: 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 e $socket10_9_te
a270: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
a280: 65 74 20 69 0a 7d 20 31 30 30 0a 0a 74 65 73 74 et i.} 100..test
a290: 20 74 6c 73 49 4f 2d 31 31 2e 38 20 7b 63 6c 69 tlsIO-11.8 {cli
a2a0: 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 6c ent with several
a2b0: 20 73 65 72 76 65 72 73 7d 20 7b 73 6f 63 6b 65 servers} {socke
a2c0: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
a2d0: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
a2e0: 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a sendCertValues.
a2f0: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
a300: 7b 0a 09 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 {..tls::init -ce
a310: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
a320: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
a330: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
a340: 76 65 72 4b 65 79 0a 09 73 65 74 20 73 31 20 5b verKey..set s1 [
a350: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
a360: 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 33 ver "accept 4003
a370: 22 20 34 30 30 33 5d 0a 09 73 65 74 20 73 32 20 " 4003]..set s2
a380: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
a390: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
a3a0: 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 73 33 4" 4004]..set s3
a3b0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
a3c0: 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 erver "accept 40
a3d0: 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 20 05" 4005]..proc
a3e0: 68 61 6e 64 73 68 61 6b 65 20 7b 73 20 6d 70 7d handshake {s mp}
a3f0: 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 {.. if {[eof
a400: 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 $s]} {...close
a410: 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 $s.. } elseif
a420: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 {[catch {tls::h
a430: 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 andshake $s} res
a440: 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 ult]} {...# Some
a450: 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d errors are norm
a460: 61 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 al... } elsei
a470: 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d f {$result == 1}
a480: 20 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 6b 65 {...# Handshake
a490: 20 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c 65 complete...file
a4a0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
a4b0: 65 20 22 22 0a 09 09 70 75 74 73 20 24 73 20 24 e ""...puts $s $
a4c0: 6d 70 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 mp...close $s..
a4d0: 20 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 63 }..}..proc ac
a4e0: 63 65 70 74 20 7b 6d 70 20 73 20 61 20 70 7d 20 cept {mp s a p}
a4f0: 7b 0a 09 20 20 20 20 23 20 54 68 65 73 65 20 68 {.. # These h
a500: 61 76 65 20 74 6f 20 61 63 63 65 70 74 20 6e 6f ave to accept no
a510: 6e 2d 62 6c 6f 63 6b 69 6e 67 2c 20 62 65 63 61 n-blocking, beca
a520: 75 73 65 20 74 68 65 20 68 61 6e 64 73 68 61 6b use the handshak
a530: 69 6e 67 0a 09 20 20 20 20 23 20 6f 72 64 65 72 ing.. # order
a540: 20 69 73 6e 27 74 20 64 65 74 65 72 6d 69 6e 69 isn't determini
a550: 73 74 69 63 0a 09 20 20 20 20 66 63 6f 6e 66 69 stic.. fconfi
a560: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
a570: 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 0 -buffering l
a580: 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 ine.. fileeve
a590: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
a5a0: 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 24 list handshake $
a5b0: 73 20 24 6d 70 5d 0a 09 7d 0a 20 20 20 20 7d 0a s $mp]..}. }.
a5c0: 20 20 20 20 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 tls::init -c
a5d0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
a5e0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
a5f0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
a600: 69 65 6e 74 4b 65 79 0a 20 20 20 20 73 65 74 20 ientKey. set
a610: 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s1 [tls::socket
a620: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
a630: 34 30 30 33 5d 0a 20 20 20 20 73 65 74 20 73 32 4003]. set s2
a640: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 [tls::socket $r
a650: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 emoteServerIP 40
a660: 30 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 5b 04]. set s3 [
a670: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d tls::socket $rem
a680: 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 35 oteServerIP 4005
a690: 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 ]. set l "".
a6a0: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 65 lappend l [ge
a6b0: 74 73 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 ts $s1] [gets $s
a6c0: 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 65 1] [eof $s1] [ge
a6d0: 74 73 20 24 73 32 5d 20 5b 67 65 74 73 20 24 73 ts $s2] [gets $s
a6e0: 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a 09 2] [eof $s2] \..
a6f0: 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 65 74 73 [gets $s3] [gets
a700: 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d 0a $s3] [eof $s3].
a710: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
a720: 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 close $s2.
a730: 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 close $s3. se
a740: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f ndCommand {..clo
a750: 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 73 se $s1..close $s
a760: 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 2..close $s3.
a770: 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b }. set l.} {
a780: 34 30 30 33 20 7b 7d 20 31 20 34 30 30 34 20 7b 4003 {} 1 4004 {
a790: 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a 0a } 1 4005 {} 1}..
a7a0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 39 20 test tlsIO-11.9
a7b0: 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b {accept callback
a7c0: 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 error} {socket
a7d0: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
a7e0: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
a7f0: 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et s [tls::socke
a800: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
a810: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
a820: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
a830: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
a840: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
a850: 72 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 20 r accept 8836].
a860: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
a870: 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 s a p} {expr 10
a880: 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 / 0}. proc bg
a890: 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c error args {..gl
a8a0: 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 obal x..set x $a
a8b0: 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 rgs. }. se
a8c0: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
a8d0: 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e if {[catch {sen
a8e0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 dCommand {..
a8f0: 73 65 74 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 set peername [fc
a900: 6f 6e 66 69 67 75 72 65 20 24 63 61 6c 6c 65 72 onfigure $caller
a910: 53 6f 63 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 Socket -peername
a920: 5d 0a 09 20 20 20 20 73 65 74 20 73 20 5b 74 6c ].. set s [tl
a930: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 20 20 s::socket \...
a940: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
a950: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
a960: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
a970: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 09 $clientKey \...
a980: 20 20 20 20 5b 6c 69 6e 64 65 78 20 24 70 65 65 [lindex $pee
a990: 72 6e 61 6d 65 20 30 5d 20 38 38 33 36 5d 0a 09 rname 0] 8836]..
a9a0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
a9b0: 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 . }} msg]} {..c
a9c0: 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 24 lose $s..error $
a9d0: 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 msg. }. se
a9e0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
a9f0: 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 0000 "set x time
aa00: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
aa10: 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 t x. after ca
aa20: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
aa30: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e close $s. ren
aa40: 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 ame bgerror {}.
aa50: 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 set x.} {{div
aa60: 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 ide by zero}}..t
aa70: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 20 est tlsIO-11.10
aa80: 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 {testing socket
aa90: 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 specific options
aaa0: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
aab0: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
aac0: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 r} {. sendCer
aad0: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
aae0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
aaf0: 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f ocket10_12_test_
ab00: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
ab10: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
ab20: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
ab30: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
ab40: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
ab50: 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 y \...-server ac
ab60: 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 cept 8836]..proc
ab70: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
ab80: 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 7d {close $s}. }
ab90: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
aba0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
abb0: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
abc0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
abd0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
abe0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
abf0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
ac00: 38 38 33 36 5d 0a 20 20 20 20 73 65 74 20 70 20 8836]. set p
ac10: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
ac20: 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 73 65 peername]. se
ac30: 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 t n [fconfigure
ac40: 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 $s -sockname].
ac50: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
ac60: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 append l [lindex
ac70: 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 $p 2] [llength
ac80: 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d $p] [llength $p]
ac90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
aca0: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
acb0: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 lose $socket10_1
acc0: 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 2_test_server}.
acd0: 20 20 20 73 65 74 20 6c 0a 7d 20 7b 38 38 33 36 set l.} {8836
ace0: 20 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 3 3}..test tlsI
acf0: 4f 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 6e 67 O-11.11 {testing
ad00: 20 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 73 spurious events
ad10: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
ad20: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
ad30: 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f 74 r} {. # remot
ad40: 65 20 65 71 75 69 76 61 6c 65 6e 74 20 6f 66 20 e equivalent of
ad50: 39 2e 31 0a 20 20 20 20 73 65 6e 64 43 65 72 74 9.1. sendCert
ad60: 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 Values. sendC
ad70: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
ad80: 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 72 cket_test_server
ad90: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 [tls::socket -s
ada0: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
adb0: 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 .-certfile $serv
adc0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
add0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
ade0: 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d $serverKey 8836]
adf0: 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b 65 ..proc handshake
ae00: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b {s} {.. if {
ae10: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
ae20: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
ae30: 73 65 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c seif {[catch {tl
ae40: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 7d s::handshake $s}
ae50: 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 result]} {...#
ae60: 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 65 20 Some errors are
ae70: 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 65 normal... } e
ae80: 6c 73 65 69 66 20 7b 24 72 65 73 75 6c 74 20 3d lseif {$result =
ae90: 3d 20 31 7d 20 7b 0a 09 09 23 20 48 61 6e 64 73 = 1} {...# Hands
aea0: 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a 09 09 hake complete...
aeb0: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 fileevent $s wri
aec0: 74 61 62 6c 65 20 22 22 0a 09 09 61 66 74 65 72 table ""...after
aed0: 20 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 24 100 writesome $
aee0: 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 70 72 6f s.. }..}..pro
aef0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
af00: 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 {.. fconfigu
af10: 72 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 re $s -translati
af20: 6f 6e 20 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 on "auto lf"..
af30: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 fileevent $s w
af40: 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 ritable [list ha
af50: 6e 64 73 68 61 6b 65 20 24 73 5d 0a 09 7d 0a 09 ndshake $s]..}..
af60: 70 72 6f 63 20 77 72 69 74 65 73 6f 6d 65 20 7b proc writesome {
af70: 73 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 7b 73 s} {.. for {s
af80: 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 et i 0} {$i < 10
af90: 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 0} {incr i} {...
afa0: 70 75 74 73 20 24 73 20 22 6c 69 6e 65 20 24 69 puts $s "line $i
afb0: 20 66 72 6f 6d 20 72 65 6d 6f 74 65 20 73 65 72 from remote ser
afc0: 76 65 72 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 ver".. }..
afd0: 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 close $s..}.
afe0: 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 }. set len 0
aff0: 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 . set spuriou
b000: 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 s 0. set done
b010: 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 0. proc read
b020: 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c little {s} {..gl
b030: 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f obal spurious do
b040: 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 ne len..set l [r
b050: 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b ead $s 1]..if {[
b060: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
b070: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 ] == 0} {.. i
b080: 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a f {![eof $s]} {.
b090: 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a ..incr spurious.
b0a0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
b0b0: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 close $s...set d
b0c0: 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 one 1.. }..}
b0d0: 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 else {.. incr
b0e0: 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e len [string len
b0f0: 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d gth $l]..}. }
b100: 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a . set c [tls:
b110: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
b120: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
b130: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
b140: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
b150: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
b160: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
b170: 38 38 33 36 5d 0a 20 20 20 20 23 20 47 65 74 20 8836]. # Get
b180: 74 68 65 20 62 75 66 66 65 72 69 6e 67 20 63 6f the buffering co
b190: 72 72 65 63 74 65 64 0a 20 20 20 20 66 63 6f 6e rrected. fcon
b1a0: 66 69 67 75 72 65 20 24 63 20 2d 62 75 66 66 65 figure $c -buffe
b1b0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 23 20 ring line. #
b1c0: 50 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f 20 Put a byte into
b1d0: 74 68 65 20 63 6c 69 65 6e 74 20 70 69 70 65 20 the client pipe
b1e0: 74 6f 20 74 72 69 67 67 65 72 20 54 4c 53 20 68 to trigger TLS h
b1f0: 61 6e 64 73 68 61 6b 69 6e 67 0a 20 20 20 20 70 andshaking. p
b200: 75 74 73 20 24 63 20 61 0a 20 20 20 20 66 69 6c uts $c a. fil
b210: 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 eevent $c readab
b220: 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 le [list readlit
b230: 74 6c 65 20 24 63 5d 0a 20 20 20 20 73 65 74 20 tle $c]. set
b240: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
b250: 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 00 "set done tim
b260: 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 ed_out"]. vwa
b270: 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 it done. afte
b280: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
b290: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
b2a0: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 5f 74 {close $socket_t
b2b0: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
b2c0: 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 list $spurious $
b2d0: 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a 0a len.} {0 2690}..
b2e0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 32 test tlsIO-11.12
b2f0: 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 {testing EOF st
b300: 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 ickyness} {unexp
b310: 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 6f lainedFailure so
b320: 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 cket doTestsWith
b330: 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a RemoteServer} {.
b340: 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 71 75 # remote equ
b350: 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 33 0a 20 ivalent of 9.3.
b360: 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 # HOBBS: neve
b370: 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 63 74 r worked correct
b380: 6c 79 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 ly. set count
b390: 65 72 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e er 0. set don
b3a0: 65 20 30 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 e 0. proc cou
b3b0: 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f nt_up {s} {..glo
b3c0: 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f 6e 65 bal counter done
b3d0: 20 61 66 74 65 72 5f 69 64 0a 09 73 65 74 20 6c after_id..set l
b3e0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b [gets $s]..if {
b3f0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 [eof $s]} {..
b400: 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a 09 20 incr counter..
b410: 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 72 20 if {$counter
b420: 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 6f 6e > 9} {...set don
b430: 65 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 e {EOF is sticky
b440: 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c }...after cancel
b450: 20 24 61 66 74 65 72 5f 69 64 0a 09 09 63 6c 6f $after_id...clo
b460: 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a se $s.. }..}.
b470: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 }. proc t
b480: 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 imed_out {} {..g
b490: 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 73 65 lobal c done..se
b4a0: 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 t done {timed_ou
b4b0: 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 73 74 t, EOF is not st
b4c0: 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a icky}..close $c.
b4d0: 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 }. sendCe
b4e0: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
b4f0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
b500: 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 socket10_14_test
b510: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
b520: 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 cket \...-certfi
b530: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
b540: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
b550: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
b560: 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 ey \...-server a
b570: 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f ccept 8836]..pro
b580: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
b590: 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e {.. tls::han
b5a0: 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 61 dshake $s.. a
b5b0: 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 24 fter 100 close $
b5c0: 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 s..}. }. s
b5d0: 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et c [tls::socke
b5e0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
b5f0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
b600: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
b610: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
b620: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
b630: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
b640: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 fileevent $c
b650: 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 readable "count
b660: 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 74 20 _up $c". set
b670: 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 72 20 after_id [after
b680: 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 1000 timed_out].
b690: 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 vwait done.
b6a0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
b6b0: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f close $socket10_
b6c0: 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 14_test_server}.
b6d0: 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b set done.} {
b6e0: 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a EOF is sticky}..
b6f0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 33 test tlsIO-11.13
b700: 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 {testing async
b710: 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 6c 75 write, async flu
b720: 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 7d sh, async close}
b730: 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 \..{socket doTe
b740: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
b750: 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 ver} {. proc
b760: 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c readit {s} {..gl
b770: 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a obal count done.
b780: 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d .set l [read $s]
b790: 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 ..incr count [st
b7a0: 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a ring length $l].
b7b0: 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b .if {[eof $s]} {
b7c0: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
b7d0: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 set done 1..
b7e0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 }. }. send
b7f0: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
b800: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
b810: 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 t firstblock [st
b820: 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 31 ring repeat a 31
b830: 5d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f ]..set secondblo
b840: 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 ck [string repea
b850: 74 20 62 20 36 35 35 33 35 5d 0a 09 73 65 74 20 t b 65535]..set
b860: 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c l [tls::socket \
b870: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
b880: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
b890: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
b8a0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
b8b0: 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 .-server accept
b8c0: 38 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 8845]..proc acce
b8d0: 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 pt {s a p} {..
b8e0: 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 tls::handshake
b8f0: 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 $s.. fconfig
b900: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
b910: 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 0 -translation
b920: 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 lf -buffersize 1
b930: 36 33 38 34 20 5c 0a 09 09 20 20 20 20 2d 62 75 6384 \... -bu
b940: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 ffering line..
b950: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
b960: 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 6c eadable "readabl
b970: 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 e $s"..}..proc r
b980: 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 eadable {s} {..
b990: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
b9a0: 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e s].. fileeven
b9b0: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d t $s readable {}
b9c0: 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 .. after 1000
b9d0: 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 respond $s..}..
b9e0: 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d proc respond {s}
b9f0: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 {.. global f
ba00: 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 irstblock.. p
ba10: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 uts -nonewline $
ba20: 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 s $firstblock..
ba30: 20 20 20 61 66 74 65 72 20 31 30 30 30 20 77 72 after 1000 wr
ba40: 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 itedata $s..}..p
ba50: 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 roc writedata {s
ba60: 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 } {.. global
ba70: 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 secondblock..
ba80: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
ba90: 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b $s $secondblock
baa0: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
bab0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 }. }. set
bac0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
bad0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
bae0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
baf0: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
bb00: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
bb10: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
bb20: 72 76 65 72 49 50 20 38 38 34 35 5d 0a 20 20 20 rverIP 8845].
bb30: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
bb40: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
bb50: 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 slation lf -buff
bb60: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
bb70: 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 et count 0. p
bb80: 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 uts $s hello.
bb90: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
bba0: 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 adable "readit $
bbb0: 73 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 s". set timer
bbc0: 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 [after 10000 "s
bbd0: 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 et done timed_ou
bbe0: 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f t"]. vwait do
bbf0: 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e ne. after can
bc00: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 cel $timer. s
bc10: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
bc20: 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 6f e $l}. set co
bc30: 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 70 72 6f unt.} 65566..pro
bc40: 63 20 67 65 74 64 61 74 61 20 7b 74 79 70 65 20 c getdata {type
bc50: 66 69 6c 65 7d 20 7b 0a 20 20 20 20 23 20 52 65 file} {. # Re
bc60: 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 ad handler on th
bc70: 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 e accepted socke
bc80: 74 2e 0a 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a t.. global x.
bc90: 20 20 20 20 67 6c 6f 62 61 6c 20 66 61 69 6c 65 global faile
bca0: 64 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 d. set status
bcb0: 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 [catch {read $f
bcc0: 69 6c 65 7d 20 64 61 74 61 5d 0a 20 20 20 20 69 ile} data]. i
bcd0: 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d f {$status != 0}
bce0: 20 7b 0a 09 73 65 74 20 78 20 22 72 65 61 64 20 {..set x "read
bcf0: 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 failed, error wa
bd00: 73 20 24 64 61 74 61 22 0a 09 63 61 74 63 68 20 s $data"..catch
bd10: 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a { close $file }.
bd20: 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 64 } elseif {$d
bd30: 61 74 61 20 6e 65 20 7b 7d 7d 20 7b 0a 20 20 20 ata ne {}} {.
bd40: 20 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f } elseif {[fblo
bd50: 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 20 cked $file]} {.
bd60: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f } elseif {[eo
bd70: 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 69 66 20 f $file]} {..if
bd80: 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 20 20 20 {$failed} {..
bd90: 20 73 65 74 20 78 20 22 24 74 79 70 65 20 73 6f set x "$type so
bda0: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
bdb0: 65 64 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 ed"..} else {..
bdc0: 20 20 20 73 65 74 20 78 20 22 24 74 79 70 65 20 set x "$type
bdd0: 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 socket was not i
bde0: 6e 68 65 72 69 74 65 64 22 0a 09 7d 0a 09 63 61 nherited"..}..ca
bdf0: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c tch { close $fil
be00: 65 20 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b e }. } else {
be10: 0a 09 73 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 ..set x {impossi
be20: 62 6c 65 20 63 61 73 65 7d 0a 09 63 61 74 63 68 ble case}..catch
be30: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
be40: 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 . }. retur
be50: 6e 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d n.}..test tlsIO-
be60: 31 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 69 6e 12.1 {testing in
be70: 68 65 72 69 74 61 6e 63 65 20 6f 66 20 73 65 72 heritance of ser
be80: 76 65 72 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f ver sockets} {so
be90: 63 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 cket exec} {.
bea0: 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 makeFile {} scr
beb0: 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c ipt1. makeFil
bec0: 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 e {} script2..
bed0: 20 20 23 20 53 63 72 69 70 74 31 20 69 73 20 6a # Script1 is j
bee0: 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e 64 20 ust a 10 second
bef0: 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 20 73 delay. If the s
bf00: 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 erver socket.
bf10: 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 64 2c # is inherited,
bf20: 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 it will be held
bf30: 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 65 63 open for 10 sec
bf40: 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 66 20 onds.. set f
bf50: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
bf60: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
bf70: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
bf80: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
bf90: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
bfa0: 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 $f.. # Script
bfb0: 32 20 63 72 65 61 74 65 73 20 74 68 65 20 73 65 2 creates the se
bfc0: 72 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c 61 75 rver socket, lau
bfd0: 6e 63 68 65 73 20 73 63 72 69 70 74 31 2c 0a 20 nches script1,.
bfe0: 20 20 20 23 20 77 61 69 74 73 20 61 20 73 65 63 # waits a sec
bff0: 6f 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 2e 20 ond, and exits.
c000: 20 54 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b The server sock
c010: 65 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 20 et will now.
c020: 23 20 62 65 20 63 6c 6f 73 65 64 20 75 6e 6c 65 # be closed unle
c030: 73 73 20 73 63 72 69 70 74 31 20 69 6e 68 65 72 ss script1 inher
c040: 69 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 73 65 ited it... se
c050: 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 t f [open script
c060: 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 2 w]. puts $f
c070: 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c 73 68 [list set tclsh
c080: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
c090: 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 20 24 test]. puts $
c0a0: 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 6f f [list set auto
c0b0: 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 68 _path $auto_path
c0c0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a ]. puts $f {.
c0d0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
c0e0: 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 tls. }. p
c0f0: 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b uts $f "set f \[
c100: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
c110: 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 20 20 ver accept \..
c120: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
c130: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
c140: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
c150: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 32 38 $serverKey 8828
c160: 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 66 20 \]". puts $f
c170: 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b {..proc accept {
c180: 20 66 69 6c 65 20 61 64 64 72 20 70 6f 72 74 20 file addr port
c190: 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 } {.. close $
c1a0: 66 69 6c 65 0a 09 7d 0a 09 65 78 65 63 20 24 74 file..}..exec $t
c1b0: 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 clsh script1 &..
c1c0: 63 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 72 20 close $f..after
c1d0: 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 1000 exit..vwait
c1e0: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
c1f0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
c200: 20 23 20 4c 61 75 6e 63 68 20 73 63 72 69 70 74 # Launch script
c210: 32 20 61 6e 64 20 77 61 69 74 20 35 20 73 65 63 2 and wait 5 sec
c220: 6f 6e 64 73 0a 0a 20 20 20 20 65 78 65 63 20 24 onds.. exec $
c230: 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 ::tcltest::tclte
c240: 73 74 20 73 63 72 69 70 74 32 20 26 0a 20 20 20 st script2 &.
c250: 20 61 66 74 65 72 20 35 30 30 30 20 7b 20 73 65 after 5000 { se
c260: 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 t ok_to_proceed
c270: 31 20 7d 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 1 }. vwait ok
c280: 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 _to_proceed..
c290: 20 23 20 49 66 20 77 65 20 63 61 6e 20 73 74 69 # If we can sti
c2a0: 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 ll connect to th
c2b0: 65 20 73 65 72 76 65 72 2c 20 74 68 65 20 73 6f e server, the so
c2c0: 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 69 74 cket got inherit
c2d0: 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 ed... if {[ca
c2e0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
c2f0: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
c300: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
c310: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
c320: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
c330: 20 20 20 09 20 31 32 37 2e 30 2e 30 2e 31 20 38 . 127.0.0.1 8
c340: 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 828} msg]} {..se
c350: 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b t x {server sock
c360: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
c370: 69 74 65 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 ited}. } else
c380: 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 {..close $msg..
c390: 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f set x {server so
c3a0: 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 69 74 cket was inherit
c3b0: 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 ed}. }.. s
c3c0: 65 74 20 78 0a 7d 20 7b 73 65 72 76 65 72 20 73 et x.} {server s
c3d0: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
c3e0: 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 herited}..test t
c3f0: 6c 73 49 4f 2d 31 32 2e 32 20 7b 74 65 73 74 69 lsIO-12.2 {testi
c400: 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f ng inheritance o
c410: 66 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 73 f client sockets
c420: 7d 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 } {socket exec}
c430: 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b {. makeFile {
c440: 7d 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 } script1. ma
c450: 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 keFile {} script
c460: 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 74 31 2.. # Script1
c470: 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 73 65 is just a 10 se
c480: 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 66 20 cond delay. If
c490: 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 the server socke
c4a0: 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 65 72 t. # is inher
c4b0: 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 ited, it will be
c4c0: 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 held open for 1
c4d0: 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 0 seconds.. s
c4e0: 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 et f [open scrip
c4f0: 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 20 24 t1 w]. puts $
c500: 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 30 30 f {..after 10000
c510: 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 72 exit..vwait for
c520: 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 ever. }. c
c530: 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 53 lose $f.. # S
c540: 63 72 69 70 74 32 20 6f 70 65 6e 73 20 74 68 65 cript2 opens the
c550: 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 20 61 client socket a
c560: 6e 64 20 77 72 69 74 65 73 20 74 6f 20 69 74 2e nd writes to it.
c570: 20 20 49 74 20 74 68 65 6e 0a 20 20 20 20 23 20 It then. #
c580: 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 launches script1
c590: 20 61 6e 64 20 65 78 69 74 73 2e 20 20 49 66 20 and exits. If
c5a0: 74 68 65 20 63 68 69 6c 64 20 70 72 6f 63 65 73 the child proces
c5b0: 73 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 0a s inherited the.
c5c0: 20 20 20 20 23 20 63 6c 69 65 6e 74 20 73 6f 63 # client soc
c5d0: 6b 65 74 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 ket, the socket
c5e0: 77 69 6c 6c 20 73 74 69 6c 6c 20 62 65 20 6f 70 will still be op
c5f0: 65 6e 2e 0a 0a 20 20 20 20 73 65 74 20 66 20 5b en... set f [
c600: 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a open script2 w].
c610: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
c620: 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 t set tclsh $::t
c630: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d cltest::tcltest]
c640: 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 . puts $f [li
c650: 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 st set auto_path
c660: 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 $auto_path].
c670: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b puts $f {..pack
c680: 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a age require tls.
c690: 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 }. puts $
c6a0: 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a f "set f \[tls::
c6b0: 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 socket -certfile
c6c0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
c6d0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 file $caCert \..
c6e0: 20 20 20 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c -keyfile $cl
c6f0: 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e ientKey 127.0.0.
c700: 31 20 38 38 32 39 5c 5d 22 0a 20 20 20 20 70 75 1 8829\]". pu
c710: 74 73 20 24 66 20 7b 0a 09 65 78 65 63 20 24 74 ts $f {..exec $t
c720: 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 0a 09 clsh script1 &..
c730: 70 75 74 73 20 24 66 20 74 65 73 74 69 6e 67 0a puts $f testing.
c740: 09 66 6c 75 73 68 20 24 66 0a 09 61 66 74 65 72 .flush $f..after
c750: 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 69 1000 exit..vwai
c760: 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a t forever. }.
c770: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 close $f..
c780: 20 20 23 20 43 72 65 61 74 65 20 74 68 65 20 73 # Create the s
c790: 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 erver socket..
c7a0: 20 20 73 65 74 20 73 65 72 76 65 72 20 5b 74 6c set server [tl
c7b0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
c7c0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
c7d0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
c7e0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
c7f0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
c800: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
c810: 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 8829]. proc
c820: 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f accept { file ho
c830: 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 23 20 57 st port } {..# W
c840: 68 65 6e 20 74 68 65 20 63 6c 69 65 6e 74 20 63 hen the client c
c850: 6f 6e 6e 65 63 74 73 2c 20 65 73 74 61 62 6c 69 onnects, establi
c860: 73 68 20 74 68 65 20 72 65 61 64 20 68 61 6e 64 sh the read hand
c870: 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 ler..global serv
c880: 65 72 0a 09 63 6c 6f 73 65 20 24 73 65 72 76 65 er..close $serve
c890: 72 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 66 r..fconfigure $f
c8a0: 69 6c 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a ile -blocking 0.
c8b0: 09 66 69 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 .fileevent $file
c8c0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
c8d0: 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 66 69 do_handshake $fi
c8e0: 6c 65 20 72 65 61 64 61 62 6c 65 20 5c 0a 09 09 le readable \...
c8f0: 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 63 6c [list getdata cl
c900: 69 65 6e 74 5d 20 2d 62 75 66 66 65 72 69 6e 67 ient] -buffering
c910: 20 6c 69 6e 65 5d 0a 09 72 65 74 75 72 6e 0a 20 line]..return.
c920: 20 20 20 7d 0a 0a 20 20 20 20 23 20 49 66 20 74 }.. # If t
c930: 68 65 20 73 6f 63 6b 65 74 20 64 6f 65 73 6e 27 he socket doesn'
c940: 74 20 68 69 74 20 65 6e 64 2d 6f 66 2d 66 69 6c t hit end-of-fil
c950: 65 20 69 6e 20 35 20 73 65 63 6f 6e 64 73 2c 20 e in 5 seconds,
c960: 74 68 65 0a 20 20 20 20 23 20 73 63 72 69 70 74 the. # script
c970: 31 20 70 72 6f 63 65 73 73 20 6d 75 73 74 20 68 1 process must h
c980: 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 ave inherited th
c990: 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 20 73 e client... s
c9a0: 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 et failed 0.
c9b0: 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 73 74 after 5000 [list
c9c0: 20 73 65 74 20 66 61 69 6c 65 64 20 31 5d 0a 0a set failed 1]..
c9d0: 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 # Launch the
c9e0: 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 script2 process
c9f0: 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 .. exec $::tc
ca00: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
ca10: 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 76 77 cript2 &.. vw
ca20: 61 69 74 20 78 0a 20 20 20 20 69 66 20 7b 21 24 ait x. if {!$
ca30: 66 61 69 6c 65 64 7d 20 7b 0a 09 76 77 61 69 74 failed} {..vwait
ca40: 20 66 61 69 6c 65 64 0a 20 20 20 20 7d 0a 20 20 failed. }.
ca50: 20 20 73 65 74 20 78 0a 7d 20 7b 63 6c 69 65 6e set x.} {clien
ca60: 74 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 t socket was not
ca70: 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 inherited}..tes
ca80: 74 20 74 6c 73 49 4f 2d 31 32 2e 33 20 7b 74 65 t tlsIO-12.3 {te
ca90: 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 sting inheritanc
caa0: 65 20 6f 66 20 61 63 63 65 70 74 65 64 20 73 6f e of accepted so
cab0: 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 ckets} \..{socke
cac0: 74 20 65 78 65 63 20 75 6e 69 78 4f 6e 6c 79 7d t exec unixOnly}
cad0: 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 {. makeFile
cae0: 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 20 6d {} script1. m
caf0: 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 akeFile {} scrip
cb00: 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f t2.. set f [o
cb10: 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 pen script1 w].
cb20: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 puts $f {..af
cb30: 74 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 ter 10000 exit..
cb40: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
cb50: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
cb60: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
cb70: 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 n script2 w].
cb80: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
cb90: 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 et tclsh $::tclt
cba0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 est::tcltest].
cbb0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
cbc0: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
cbd0: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
cbe0: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
cbf0: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
cc00: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
cc10: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
cc20: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
cc30: 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 pt \.. -certf
cc40: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
cc50: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
cc60: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
cc70: 4b 65 79 20 38 39 33 30 5c 5d 22 0a 20 20 20 20 Key 8930\]".
cc80: 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 puts $f {..proc
cc90: 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 68 6f accept { file ho
cca0: 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 st port } {..
ccb0: 20 67 6c 6f 62 61 6c 20 74 63 6c 73 68 0a 09 20 global tclsh..
ccc0: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
ccd0: 69 6c 65 20 2d 62 75 66 66 65 72 69 6e 67 20 6c ile -buffering l
cce0: 69 6e 65 0a 09 20 20 20 20 70 75 74 73 20 24 66 ine.. puts $f
ccf0: 69 6c 65 20 7b 74 65 73 74 20 64 61 74 61 20 6f ile {test data o
cd00: 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 20 65 n socket}.. e
cd10: 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 69 70 xec $tclsh scrip
cd20: 74 31 20 26 0a 09 20 20 20 20 61 66 74 65 72 20 t1 &.. after
cd30: 31 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 76 77 1000 exit..}..vw
cd40: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
cd50: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
cd60: 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 68 65 # Launch the
cd70: 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 73 73 script2 process
cd80: 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 and connect to
cd90: 69 74 2e 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e it. See how lon
cda0: 67 0a 20 20 20 20 23 20 74 68 65 20 73 6f 63 6b g. # the sock
cdb0: 65 74 20 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 et stays open..
cdc0: 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 exec $::tclte
cdd0: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
cde0: 70 74 32 20 26 0a 0a 20 20 20 20 61 66 74 65 72 pt2 &.. after
cdf0: 20 32 30 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 2000 set ok_to_
ce00: 70 72 6f 63 65 65 64 20 31 0a 20 20 20 20 76 77 proceed 1. vw
ce10: 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 ait ok_to_procee
ce20: 64 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 74 6c d.. set f [tl
ce30: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
ce40: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
ce50: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
ce60: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
ce70: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
ce80: 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 39 33 30 127.0.0.1 8930
ce90: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
cea0: 20 24 66 20 2d 62 75 66 66 65 72 69 6e 67 20 66 $f -buffering f
ceb0: 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a ull -blocking 0.
cec0: 20 20 20 20 23 20 57 65 20 6e 65 65 64 20 74 6f # We need to
ced0: 20 70 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f put a byte into
cee0: 20 74 68 65 20 72 65 61 64 20 71 75 65 75 65 2c the read queue,
cef0: 20 6f 74 68 65 72 77 69 73 65 20 74 68 65 0a 20 otherwise the.
cf00: 20 20 20 23 20 54 4c 53 20 68 61 6e 64 73 68 61 # TLS handsha
cf10: 6b 65 20 64 6f 65 73 6e 27 74 20 66 69 6e 69 73 ke doesn't finis
cf20: 68 0a 20 20 20 20 70 75 74 73 20 24 66 20 61 3b h. puts $f a;
cf30: 20 66 6c 75 73 68 20 24 66 0a 20 20 20 20 66 69 flush $f. fi
cf40: 6c 65 65 76 65 6e 74 20 24 66 20 72 65 61 64 61 leevent $f reada
cf50: 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 61 74 ble [list getdat
cf60: 61 20 61 63 63 65 70 74 65 64 20 24 66 5d 0a 0a a accepted $f]..
cf70: 20 20 20 20 23 20 49 66 20 74 68 65 20 73 6f 63 # If the soc
cf80: 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 ket is still ope
cf90: 6e 20 61 66 74 65 72 20 35 20 73 65 63 6f 6e 64 n after 5 second
cfa0: 73 2c 20 74 68 65 20 73 63 72 69 70 74 31 20 70 s, the script1 p
cfb0: 72 6f 63 65 73 73 0a 20 20 20 20 23 20 6d 75 73 rocess. # mus
cfc0: 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 t have inherited
cfd0: 20 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f the accepted so
cfe0: 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 cket... set f
cff0: 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 65 ailed 0. afte
d000: 72 20 35 30 30 30 20 73 65 74 20 66 61 69 6c 65 r 5000 set faile
d010: 64 20 31 0a 0a 20 20 20 20 76 77 61 69 74 20 78 d 1.. vwait x
d020: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 . set x.} {ac
d030: 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 77 61 cepted socket wa
d040: 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 64 7d s not inherited}
d050: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e ..test tlsIO-13.
d060: 31 20 7b 54 65 73 74 69 6e 67 20 75 73 65 20 6f 1 {Testing use o
d070: 66 20 73 68 61 72 65 64 20 73 6f 63 6b 65 74 20 f shared socket
d080: 62 65 74 77 65 65 6e 20 74 77 6f 20 74 68 72 65 between two thre
d090: 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 ads} \..{socket
d0a0: 74 65 73 74 74 68 72 65 61 64 7d 20 7b 0a 20 20 testthread} {.
d0b0: 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 # HOBBS: never
d0c0: 20 74 65 73 74 65 64 0a 20 20 20 20 72 65 6d 6f tested. remo
d0d0: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
d0e0: 20 20 74 68 72 65 61 64 52 65 61 70 0a 0a 20 20 threadReap..
d0f0: 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 makeFile {.
d100: 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 .package requir
d110: 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c e tls..set f [tl
d120: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
d130: 72 20 61 63 63 65 70 74 20 38 38 32 38 5d 0a 09 r accept 8828]..
d140: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
d150: 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 p} {.
d160: 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 fileevent $s r
d170: 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 eadable [list ec
d180: 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 ho $s].
d190: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
d1a0: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
d1b0: 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 . }..proc
d1c0: 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 echo {s} {..
d1d0: 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 global i.
d1e0: 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 5b 67 set l [g
d1f0: 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 20 20 ets $s].
d200: 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 if {[eof $s
d210: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 ]} {.
d220: 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 global x.
d230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d240: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 20 close $s.
d250: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 20 set x
d260: 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 20 done.
d270: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 } else {..
d280: 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 20 20 incr i.
d290: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 put
d2a0: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
d2b0: 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 }..}..set i
d2c0: 20 30 0a 09 76 77 61 69 74 20 78 0a 09 63 6c 6f 0..vwait x..clo
d2d0: 73 65 20 24 66 0a 0a 09 23 20 74 68 72 65 61 64 se $f...# thread
d2e0: 20 63 6c 65 61 6e 73 20 69 74 73 65 6c 66 20 75 cleans itself u
d2f0: 70 2e 0a 09 74 65 73 74 74 68 72 65 61 64 20 65 p...testthread e
d300: 78 69 74 0a 20 20 20 20 7d 20 73 63 72 69 70 74 xit. } script
d310: 0a 0a 20 20 20 20 23 20 63 72 65 61 74 65 20 61 .. # create a
d320: 20 74 68 72 65 61 64 0a 20 20 20 20 73 65 74 20 thread. set
d330: 73 65 72 76 65 72 74 68 72 65 61 64 20 5b 74 65 serverthread [te
d340: 73 74 74 68 72 65 61 64 20 63 72 65 61 74 65 20 stthread create
d350: 7b 20 73 6f 75 72 63 65 20 73 63 72 69 70 74 20 { source script
d360: 7d 20 5d 0a 20 20 20 20 75 70 64 61 74 65 0a 0a } ]. update..
d370: 20 20 20 20 61 66 74 65 72 20 31 30 30 30 0a 20 after 1000.
d380: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
d390: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
d3a0: 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 8828]. fconfi
d3b0: 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 gure $s -bufferi
d3c0: 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 ng line.. cat
d3d0: 63 68 20 7b 0a 09 70 75 74 73 20 24 73 20 22 68 ch {..puts $s "h
d3e0: 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 20 72 ello"..gets $s r
d3f0: 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 esult. }.
d400: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 70 64 close $s. upd
d410: 61 74 65 0a 0a 20 20 20 20 61 66 74 65 72 20 32 ate.. after 2
d420: 30 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 000. lappend
d430: 72 65 73 75 6c 74 20 5b 74 68 72 65 61 64 52 65 result [threadRe
d440: 61 70 5d 0a 0a 20 20 20 20 73 65 74 20 72 65 73 ap].. set res
d450: 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d ult..} {hello 1}
d460: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e ..test tlsIO-14.
d470: 31 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 1 {test tls::uni
d480: 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 mport} {socket}
d490: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
d4a0: 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 h {tls::unimport
d4b0: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
d4c0: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
d4d0: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
d4e0: 75 6e 69 6d 70 6f 72 74 20 63 68 61 6e 6e 65 6c unimport channel
d4f0: 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 "}}.test tlsIO-1
d500: 34 2e 32 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 4.2 {test tls::u
d510: 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 nimport} {socket
d520: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
d530: 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f tch {tls::unimpo
d540: 72 74 20 66 6f 6f 20 62 61 72 7d 20 6d 73 67 5d rt foo bar} msg]
d550: 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e $msg.} {1 {wron
d560: 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 g # args: should
d570: 20 62 65 20 22 74 6c 73 3a 3a 75 6e 69 6d 70 6f be "tls::unimpo
d580: 72 74 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74 65 rt channel"}}.te
d590: 73 74 20 74 6c 73 49 4f 2d 31 34 2e 33 20 7b 74 st tlsIO-14.3 {t
d5a0: 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 est tls::unimpor
d5b0: 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 t} {socket} {.
d5c0: 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 list [catch {t
d5d0: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 62 6f 67 ls::unimport bog
d5e0: 75 73 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 us} msg] $msg.}
d5f0: 7b 31 20 7b 63 61 6e 20 6e 6f 74 20 66 69 6e 64 {1 {can not find
d600: 20 63 68 61 6e 6e 65 6c 20 6e 61 6d 65 64 20 22 channel named "
d610: 62 6f 67 75 73 22 7d 7d 0a 74 65 73 74 20 74 6c bogus"}}.test tl
d620: 73 49 4f 2d 31 34 2e 34 20 7b 74 65 73 74 20 74 sIO-14.4 {test t
d630: 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 ls::unimport} {s
d640: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 73 ocket} {. # s
d650: 74 64 69 6e 20 63 61 6e 20 74 61 6b 65 20 64 69 tdin can take di
d660: 66 66 65 72 65 6e 74 20 6e 61 6d 65 73 20 61 73 fferent names as
d670: 20 74 68 65 20 22 74 6f 70 22 20 63 68 61 6e 6e the "top" chann
d680: 65 6c 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 el. list [cat
d690: 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 ch {tls::unimpor
d6a0: 74 20 73 74 64 69 6e 7d 20 6d 73 67 5d 20 5c 0a t stdin} msg] \.
d6b0: 09 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 7b .[string match {
d6c0: 62 61 64 20 63 68 61 6e 6e 65 6c 20 22 2a 22 3a bad channel "*":
d6d0: 20 6e 6f 74 20 61 20 73 74 61 63 6b 65 64 20 63 not a stacked c
d6e0: 68 61 6e 6e 65 6c 7d 20 24 6d 73 67 5d 0a 7d 20 hannel} $msg].}
d6f0: 7b 31 20 31 7d 0a 74 65 73 74 20 74 6c 73 49 4f {1 1}.test tlsIO
d700: 2d 31 34 2e 35 20 7b 74 65 73 74 20 74 6c 73 3a -14.5 {test tls:
d710: 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b :unimport} {sock
d720: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 et} {. set le
d730: 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 n 0. set spur
d740: 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 ious 0. set d
d750: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 one 0. proc r
d760: 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a eadlittle {s} {.
d770: 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 .global spurious
d780: 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c done len..set l
d790: 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 [read $s 1]..if
d7a0: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
d7b0: 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 $l] == 0} {..
d7c0: 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d if {![eof $s]}
d7d0: 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f {...incr spurio
d7e0: 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b us.. } else {
d7f0: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
d800: 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a t done 1.. }.
d810: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 .} else {.. i
d820: 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 ncr len [string
d830: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 length $l]..}.
d840: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
d850: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
d860: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
d870: 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 ocking 0..fileev
d880: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
d890: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
d8a0: 6b 65 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 ke $s readable r
d8b0: 65 61 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 eadlittle \...-b
d8c0: 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 uffering none].
d8d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
d8e0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
d8f0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
d900: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
d910: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
d920: 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 erKey \.. -se
d930: 72 76 65 72 20 61 63 63 65 70 74 20 38 38 33 31 rver accept 8831
d940: 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 ]. set c [tls
d950: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
d960: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
d970: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
d980: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
d990: 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 ey \.. localh
d9a0: 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 20 23 20 ost 8831]. #
d9b0: 6f 6e 6c 79 20 74 68 65 20 63 6c 69 65 6e 74 20 only the client
d9c0: 67 65 74 73 20 74 6c 73 3a 3a 69 6d 70 6f 72 74 gets tls::import
d9d0: 0a 20 20 20 20 73 65 74 20 72 65 73 20 5b 74 6c . set res [tl
d9e0: 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 24 63 5d 0a s::unimport $c].
d9f0: 20 20 20 20 6c 69 73 74 20 24 72 65 73 20 5b 63 list $res [c
da00: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 7d 20 atch {close $c}
da10: 65 72 72 5d 20 24 65 72 72 20 5c 0a 09 5b 63 61 err] $err \..[ca
da20: 74 63 68 20 7b 63 6c 6f 73 65 20 24 73 7d 20 65 tch {close $s} e
da30: 72 72 5d 20 24 65 72 72 0a 7d 20 7b 7b 7d 20 30 rr] $err.} {{} 0
da40: 20 7b 7d 20 30 20 7b 7d 7d 0a 0a 74 65 73 74 20 {} 0 {}}..test
da50: 74 6c 73 2d 62 75 67 35 38 2d 31 2e 30 20 7b 74 tls-bug58-1.0 {t
da60: 65 73 74 20 70 72 6f 74 6f 63 6f 6c 20 6e 65 67 est protocol neg
da70: 6f 74 69 61 74 69 6f 6e 20 66 61 69 6c 75 72 65 otiation failure
da80: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
da90: 20 23 20 46 6f 6c 6c 6f 77 69 6e 67 20 63 6f 64 # Following cod
daa0: 65 20 69 73 20 62 61 73 65 64 20 6f 6e 20 77 68 e is based on wh
dab0: 61 74 20 77 61 73 20 72 65 70 6f 72 74 65 64 20 at was reported
dac0: 69 6e 20 62 75 67 20 23 35 38 2e 20 50 72 69 6f in bug #58. Prio
dad0: 72 0a 20 20 20 20 23 20 74 6f 20 66 69 78 20 74 r. # to fix t
dae0: 68 65 20 70 72 6f 67 72 61 6d 20 77 6f 75 6c 64 he program would
daf0: 20 63 72 61 73 68 20 77 69 74 68 20 61 20 73 65 crash with a se
db00: 67 66 61 75 6c 74 2e 0a 20 20 20 20 70 72 6f 63 gfault.. proc
db10: 20 41 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 72 Accept {sock ar
db20: 67 73 7d 20 7b 0a 20 20 20 20 20 20 20 20 66 63 gs} {. fc
db30: 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b 20 2d onfigure $sock -
db40: 62 6c 6f 63 6b 69 6e 67 20 30 3b 0a 20 20 20 20 blocking 0;.
db50: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
db60: 6f 63 6b 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 ock readable [li
db70: 73 74 20 48 61 6e 64 73 68 61 6b 65 20 24 73 6f st Handshake $so
db80: 63 6b 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ck]. }. pr
db90: 6f 63 20 48 61 6e 64 73 68 61 6b 65 20 7b 73 6f oc Handshake {so
dba0: 63 6b 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 ck} {. se
dbb0: 74 20 3a 3a 64 6f 6e 65 20 48 41 4e 44 0a 20 20 t ::done HAND.
dbc0: 20 20 20 20 20 20 63 61 74 63 68 20 7b 74 6c 73 catch {tls
dbd0: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 6f 63 ::handshake $soc
dbe0: 6b 7d 20 6d 73 67 0a 20 20 20 20 20 20 20 20 73 k} msg. s
dbf0: 65 74 20 3a 3a 64 6f 6e 65 20 24 6d 73 67 0a 20 et ::done $msg.
dc00: 20 20 20 7d 0a 20 20 20 20 23 20 4e 4f 54 45 3a }. # NOTE:
dc10: 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 when doing an i
dc20: 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 n-process client
dc30: 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f /server test, bo
dc40: 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a 20 20 th sides need.
dc50: 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c # to be non-bl
dc60: 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 20 54 ocking for the T
dc70: 4c 53 20 68 61 6e 64 73 68 61 6b 65 0a 0a 20 20 LS handshake..
dc80: 20 20 23 20 53 65 72 76 65 72 20 2d 20 4f 6e 6c # Server - Onl
dc90: 79 20 61 63 63 65 70 74 20 54 4c 53 20 31 2e 33 y accept TLS 1.3
dca0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
dcb0: 3a 73 6f 63 6b 65 74 20 5c 0a 20 20 20 20 20 20 :socket \.
dcc0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
dcd0: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
dce0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
dcf0: 20 24 73 65 72 76 65 72 4b 65 79 20 2d 72 65 71 $serverKey -req
dd00: 75 65 73 74 20 30 20 5c 0a 09 2d 72 65 71 75 69 uest 0 \..-requi
dd10: 72 65 20 30 20 2d 73 73 6c 32 20 30 20 2d 73 73 re 0 -ssl2 0 -ss
dd20: 6c 33 20 30 20 2d 74 6c 73 31 20 30 20 2d 74 6c l3 0 -tls1 0 -tl
dd30: 73 31 2e 31 20 30 20 2d 74 6c 73 31 2e 32 20 30 s1.1 0 -tls1.2 0
dd40: 20 2d 74 6c 73 31 2e 33 20 31 20 5c 0a 20 20 20 -tls1.3 1 \.
dd50: 20 20 20 20 20 2d 73 65 72 76 65 72 20 41 63 63 -server Acc
dd60: 65 70 74 20 38 38 33 31 5d 0a 20 20 20 20 23 20 ept 8831]. #
dd70: 43 6c 69 65 6e 74 20 2d 20 4f 6e 6c 79 20 70 72 Client - Only pr
dd80: 6f 70 6f 73 65 20 54 4c 53 31 2e 32 0a 20 20 20 opose TLS1.2.
dd90: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
dda0: 6b 65 74 20 2d 61 73 79 6e 63 20 2d 63 61 66 69 ket -async -cafi
ddb0: 6c 65 20 24 63 61 43 65 72 74 20 2d 72 65 71 75 le $caCert -requ
ddc0: 65 73 74 20 30 20 2d 72 65 71 75 69 72 65 20 30 est 0 -require 0
ddd0: 20 5c 0a 09 2d 73 73 6c 32 20 30 20 2d 73 73 6c \..-ssl2 0 -ssl
dde0: 33 20 30 20 2d 74 6c 73 31 20 30 20 2d 74 6c 73 3 0 -tls1 0 -tls
ddf0: 31 2e 31 20 30 20 2d 74 6c 73 31 2e 32 20 31 20 1.1 0 -tls1.2 1
de00: 2d 74 6c 73 31 2e 33 20 30 20 6c 6f 63 61 6c 68 -tls1.3 0 localh
de10: 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 20 66 63 ost 8831]. fc
de20: 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f onfigure $c -blo
de30: 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 74 73 cking 0. puts
de40: 20 24 63 20 61 20 3b 20 66 6c 75 73 68 20 24 63 $c a ; flush $c
de50: 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 30 20 . after 5000
de60: 5b 6c 69 73 74 20 73 65 74 20 3a 3a 64 6f 6e 65 [list set ::done
de70: 20 74 69 6d 65 6f 75 74 5d 0a 20 20 20 20 76 77 timeout]. vw
de80: 61 69 74 20 3a 3a 64 6f 6e 65 0a 20 20 20 20 73 ait ::done. s
de90: 77 69 74 63 68 20 2d 65 78 61 63 74 20 2d 2d 20 witch -exact --
dea0: 24 3a 3a 64 6f 6e 65 20 7b 0a 20 20 20 20 20 20 $::done {.
deb0: 20 20 22 68 61 6e 64 73 68 61 6b 65 20 66 61 69 "handshake fai
dec0: 6c 65 64 3a 20 77 72 6f 6e 67 20 73 73 6c 20 76 led: wrong ssl v
ded0: 65 72 73 69 6f 6e 22 20 2d 0a 20 20 20 20 20 20 ersion" -.
dee0: 20 20 22 68 61 6e 64 73 68 61 6b 65 20 66 61 69 "handshake fai
def0: 6c 65 64 3a 20 75 6e 73 75 70 70 6f 72 74 65 64 led: unsupported
df00: 20 70 72 6f 74 6f 63 6f 6c 22 20 7b 0a 20 20 20 protocol" {.
df10: 20 20 20 20 20 20 20 20 20 73 65 74 20 3a 3a 64 set ::d
df20: 6f 6e 65 20 22 68 61 6e 64 73 68 61 6b 65 20 66 one "handshake f
df30: 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20 76 65 72 ailed: wrong ver
df40: 73 69 6f 6e 20 6e 75 6d 62 65 72 22 0a 20 20 20 sion number".
df50: 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 }. }.
df60: 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 catch {close $c
df70: 7d 0a 20 20 20 20 63 61 74 63 68 20 7b 63 6c 6f }. catch {clo
df80: 73 65 20 24 73 7d 0a 20 20 20 20 73 65 74 20 3a se $s}. set :
df90: 3a 64 6f 6e 65 0a 7d 20 7b 68 61 6e 64 73 68 61 :done.} {handsha
dfa0: 6b 65 20 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 ke failed: wrong
dfb0: 20 76 65 72 73 69 6f 6e 20 6e 75 6d 62 65 72 7d version number}
dfc0: 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 66 20 7b ..# cleanup.if {
dfd0: 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 73 6f [string match so
dfe0: 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ck* $commandSock
dff0: 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 20 70 et] == 1} {. p
e000: 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b uts $commandSock
e010: 65 74 20 65 78 69 74 0a 20 20 20 66 6c 75 73 68 et exit. flush
e020: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 0a $commandSocket.
e030: 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 }.catch {close $
e040: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a 63 commandSocket}.c
e050: 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 72 65 6d atch {close $rem
e060: 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a 3a 3a 74 oteProcChan}.::t
e070: 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e 75 70 54 cltest::cleanupT
e080: 65 73 74 73 0a 66 6c 75 73 68 20 73 74 64 6f 75 ests.flush stdou
e090: 74 0a 72 65 74 75 72 6e 0a t.return.