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 66 0123456789. f
8140: 6c 75 73 68 20 24 63 0a 20 20 20 20 73 65 74 20 lush $c. set
8150: 74 69 6d 65 72 32 20 5b 61 66 74 65 72 20 32 30 timer2 [after 20
8160: 30 30 20 5b 6c 69 73 74 20 63 6c 6f 73 65 20 24 00 [list close $
8170: 63 5d 5d 0a 20 20 20 20 73 65 74 20 74 69 6d 65 c]]. set time
8180: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
8190: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
81a0: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
81b0: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
81c0: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
81d0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
81e0: 6d 65 72 32 0a 20 20 20 20 63 61 74 63 68 20 7b mer2. catch {
81f0: 63 6c 6f 73 65 20 24 63 7d 0a 20 20 20 20 63 61 close $c}. ca
8200: 74 63 68 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 tch {close $s}.
8210: 20 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 list $spuriou
8220: 73 20 24 6c 65 6e 0a 7d 20 7b 30 20 35 30 7d 0a s $len.} {0 50}.
8230: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 32 20 .test tlsIO-9.2
8240: 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 {testing async w
8250: 72 69 74 65 2c 20 66 69 6c 65 65 76 65 6e 74 73 rite, fileevents
8260: 2c 20 66 6c 75 73 68 20 6f 6e 20 63 6c 6f 73 65 , flush on close
8270: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
8280: 20 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 set firstblock
8290: 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 [string repeat a
82a0: 20 33 31 5d 0a 20 20 20 20 73 65 74 20 73 65 63 31]. set sec
82b0: 6f 6e 64 62 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 ondblock [string
82c0: 20 72 65 70 65 61 74 20 62 20 36 35 35 33 35 5d repeat b 65535]
82d0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
82e0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
82f0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
8300: 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 ing 0..fileevent
8310: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
8320: 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 st do_handshake
8330: 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 $s readable read
8340: 61 62 6c 65 20 5c 0a 09 09 2d 74 72 61 6e 73 6c able \...-transl
8350: 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 72 ation lf -buffer
8360: 73 69 7a 65 20 31 36 33 38 34 20 2d 62 75 66 66 size 16384 -buff
8370: 65 72 69 6e 67 20 6c 69 6e 65 5d 0a 20 20 20 20 ering line].
8380: 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 61 }. proc reada
8390: 62 6c 65 20 7b 73 7d 20 7b 0a 09 73 65 74 20 6c ble {s} {..set l
83a0: 20 5b 67 65 74 73 20 24 73 5d 0a 09 64 70 75 74 [gets $s]..dput
83b0: 73 20 22 67 6f 74 20 5c 22 5b 73 74 72 69 6e 67 s "got \"[string
83c0: 20 72 65 70 6c 61 63 65 20 24 6c 20 31 30 20 65 replace $l 10 e
83d0: 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 nd-3 ...]\" \...
83e0: 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 ([string length
83f0: 24 6c 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 66 $l]) from $s"..f
8400: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
8410: 61 62 6c 65 20 7b 7d 0a 09 61 66 74 65 72 20 31 able {}..after 1
8420: 30 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 20 000 respond $s.
8430: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 72 65 }. proc re
8440: 73 70 6f 6e 64 20 7b 73 7d 20 7b 0a 09 67 6c 6f spond {s} {..glo
8450: 62 61 6c 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 bal firstblock..
8460: 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 5b 73 dputs "send \"[s
8470: 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 66 tring replace $f
8480: 69 72 73 74 62 6c 6f 63 6b 20 31 30 20 65 6e 64 irstblock 10 end
8490: 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b -3 ...]\" \...([
84a0: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 66 string length $f
84b0: 69 72 73 74 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e irstblock]) down
84c0: 20 24 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 $s"..puts -none
84d0: 77 6c 69 6e 65 20 24 73 20 24 66 69 72 73 74 62 wline $s $firstb
84e0: 6c 6f 63 6b 0a 09 61 66 74 65 72 20 31 30 30 30 lock..after 1000
84f0: 20 77 72 69 74 65 64 61 74 61 20 24 73 0a 20 20 writedata $s.
8500: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 77 72 69 }. proc wri
8510: 74 65 64 61 74 61 20 7b 73 7d 20 7b 0a 09 67 6c tedata {s} {..gl
8520: 6f 62 61 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b obal secondblock
8530: 0a 09 64 70 75 74 73 20 22 73 65 6e 64 20 5c 22 ..dputs "send \"
8540: 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 63 65 20 [string replace
8550: 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 20 31 30 20 $secondblock 10
8560: 65 6e 64 2d 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 end-3 ...]\" \..
8570: 09 28 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 .([string length
8580: 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 5d 29 20 $secondblock])
8590: 64 6f 77 6e 20 24 73 22 0a 09 70 75 74 73 20 2d down $s"..puts -
85a0: 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 20 24 73 65 nonewline $s $se
85b0: 63 6f 6e 64 62 6c 6f 63 6b 0a 09 63 6c 6f 73 65 condblock..close
85c0: 20 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 $s. }. se
85d0: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
85e0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
85f0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
8600: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8610: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
8620: 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 y \.. -server
8630: 20 61 63 63 65 70 74 20 38 38 33 32 5d 0a 20 20 accept 8832].
8640: 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f set c [tls::so
8650: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
8660: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
8670: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
8680: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
8690: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 ntKey \.. loc
86a0: 61 6c 68 6f 73 74 20 38 38 33 32 5d 0a 20 20 20 alhost 8832].
86b0: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d fconfigure $c -
86c0: 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e blocking 0 -tran
86d0: 73 20 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 s lf -buffering
86e0: 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 63 6f 75 line. set cou
86f0: 6e 74 20 30 0a 20 20 20 20 70 75 74 73 20 24 63 nt 0. puts $c
8700: 20 68 65 6c 6c 6f 0a 20 20 20 20 70 72 6f 63 20 hello. proc
8710: 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c readit {s} {..gl
8720: 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a obal count done.
8730: 09 73 65 74 20 64 61 74 61 20 5b 72 65 61 64 20 .set data [read
8740: 24 73 5d 0a 09 64 70 75 74 73 20 22 72 65 61 64 $s]..dputs "read
8750: 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 \"[string repla
8760: 63 65 20 24 64 61 74 61 20 31 30 20 65 6e 64 2d ce $data 10 end-
8770: 33 20 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 3 ...]\" \...([s
8780: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 64 61 tring length $da
8790: 74 61 5d 29 20 66 72 6f 6d 20 24 73 22 0a 09 69 ta]) from $s"..i
87a0: 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 69 6e ncr count [strin
87b0: 67 20 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 0a g length $data].
87c0: 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b .if {[eof $s]} {
87d0: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 .. close $s..
87e0: 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 set done 1..
87f0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 66 69 6c 65 }. }. file
8800: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
8810: 65 20 22 72 65 61 64 69 74 20 24 63 22 0a 20 20 e "readit $c".
8820: 20 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 set done 0.
8830: 20 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 set timer [afte
8840: 72 20 31 30 30 30 30 20 22 73 65 74 20 64 6f 6e r 10000 "set don
8850: 65 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 e timed_out"].
8860: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
8870: 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 after cancel $t
8880: 69 6d 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 imer. close $
8890: 73 0a 20 20 20 20 6c 69 73 74 20 24 63 6f 75 6e s. list $coun
88a0: 74 20 24 64 6f 6e 65 0a 7d 20 7b 36 35 35 36 36 t $done.} {65566
88b0: 20 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 1}..test tlsIO-
88c0: 39 2e 33 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 9.3 {testing EOF
88d0: 20 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e stickyness} {un
88e0: 65 78 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 explainedFailure
88f0: 20 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 socket} {. #
8900: 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 77 6f HOBBS: never wo
8910: 72 6b 65 64 20 63 6f 72 72 65 63 74 6c 79 0a 20 rked correctly.
8920: 20 20 20 70 72 6f 63 20 63 6f 75 6e 74 5f 74 6f proc count_to
8930: 5f 65 6f 66 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 _eof {s} {..glob
8940: 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 20 74 69 al count done ti
8950: 6d 65 72 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 mer..set l [gets
8960: 20 24 73 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 $s]..if {[eof $
8970: 73 5d 7d 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 s]} {.. incr
8980: 63 6f 75 6e 74 0a 09 20 20 20 20 69 66 20 7b 24 count.. if {$
8990: 63 6f 75 6e 74 20 3e 20 39 7d 20 7b 0a 09 09 63 count > 9} {...c
89a0: 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f lose $s...set do
89b0: 6e 65 20 74 72 75 65 0a 09 09 73 65 74 20 63 6f ne true...set co
89c0: 75 6e 74 20 7b 65 6f 66 20 69 73 20 73 74 69 63 unt {eof is stic
89d0: 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 ky}...after canc
89e0: 65 6c 20 24 74 69 6d 65 72 0a 09 20 20 20 20 7d el $timer.. }
89f0: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 ..}. }. pr
8a00: 6f 63 20 74 69 6d 65 72 70 72 6f 63 20 7b 7d 20 oc timerproc {}
8a10: 7b 0a 09 67 6c 6f 62 61 6c 20 64 6f 6e 65 20 63 {..global done c
8a20: 6f 75 6e 74 20 63 0a 09 73 65 74 20 64 6f 6e 65 ount c..set done
8a30: 20 74 72 75 65 0a 09 73 65 74 20 63 6f 75 6e 74 true..set count
8a40: 20 7b 74 69 6d 65 72 20 77 65 6e 74 20 6f 66 66 {timer went off
8a50: 2c 20 65 6f 66 20 69 73 20 6e 6f 74 20 73 74 69 , eof is not sti
8a60: 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 cky}..close $c.
8a70: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 }. set cou
8a80: 6e 74 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e nt 0. set don
8a90: 65 20 66 61 6c 73 65 0a 20 20 20 20 70 72 6f 63 e false. proc
8aa0: 20 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 write_then_clos
8ab0: 65 20 7b 73 7d 20 7b 0a 09 70 75 74 73 20 24 73 e {s} {..puts $s
8ac0: 20 62 79 65 0a 09 63 6c 6f 73 65 20 24 73 0a 20 bye..close $s.
8ad0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 }. proc ac
8ae0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
8af0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
8b00: 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 locking 0 -buffe
8b10: 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 ring line -trans
8b20: 6c 61 74 69 6f 6e 20 6c 66 0a 09 66 69 6c 65 65 lation lf..filee
8b30: 76 65 6e 74 20 24 73 20 77 72 69 74 61 62 6c 65 vent $s writable
8b40: 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 [list do_handsh
8b50: 61 6b 65 20 24 73 20 77 72 69 74 61 62 6c 65 20 ake $s writable
8b60: 77 72 69 74 65 5f 74 68 65 6e 5f 63 6c 6f 73 65 write_then_close
8b70: 20 5c 0a 09 09 2d 62 75 66 66 65 72 69 6e 67 20 \...-buffering
8b80: 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f line -translatio
8b90: 6e 20 6c 66 5d 0a 20 20 20 20 7d 0a 20 20 20 20 n lf]. }.
8ba0: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
8bb0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
8bc0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
8bd0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
8be0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
8bf0: 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 Key \.. -serv
8c00: 65 72 20 61 63 63 65 70 74 20 38 38 33 33 5d 0a er accept 8833].
8c10: 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a set c [tls::
8c20: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
8c30: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
8c40: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
8c50: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
8c60: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c ientKey \.. l
8c70: 6f 63 61 6c 68 6f 73 74 20 38 38 33 33 5d 0a 20 ocalhost 8833].
8c80: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 fconfigure $c
8c90: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
8ca0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
8cb0: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 anslation lf.
8cc0: 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 fileevent $c re
8cd0: 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f 74 6f adable "count_to
8ce0: 5f 65 6f 66 20 24 63 22 0a 20 20 20 20 73 65 74 _eof $c". set
8cf0: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 timer [after 20
8d00: 30 30 20 74 69 6d 65 72 70 72 6f 63 5d 0a 20 20 00 timerproc].
8d10: 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 vwait done.
8d20: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 close $s. se
8d30: 74 20 63 6f 75 6e 74 0a 7d 20 7b 65 6f 66 20 69 t count.} {eof i
8d40: 73 20 73 74 69 63 6b 79 7d 0a 0a 72 65 6d 6f 76 s sticky}..remov
8d50: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 0a 74 65 eFile script..te
8d60: 73 74 20 74 6c 73 49 4f 2d 31 30 2e 31 20 7b 74 st tlsIO-10.1 {t
8d70: 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 61 63 esting socket ac
8d80: 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 65 72 cept callback er
8d90: 72 6f 72 20 68 61 6e 64 6c 69 6e 67 7d 20 7b 73 ror handling} {s
8da0: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
8db0: 20 67 6f 74 65 72 72 6f 72 20 30 0a 20 20 20 20 goterror 0.
8dc0: 70 72 6f 63 20 62 67 65 72 72 6f 72 20 61 72 67 proc bgerror arg
8dd0: 73 20 7b 67 6c 6f 62 61 6c 20 67 6f 74 65 72 72 s {global goterr
8de0: 6f 72 3b 20 73 65 74 20 67 6f 74 65 72 72 6f 72 or; set goterror
8df0: 20 31 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 1}. set s [t
8e00: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 ls::socket -cafi
8e10: 6c 65 20 24 63 61 43 65 72 74 20 2d 73 65 72 76 le $caCert -serv
8e20: 65 72 20 61 63 63 65 70 74 20 38 38 39 38 5d 0a er accept 8898].
8e30: 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 proc accept
8e40: 7b 73 20 61 20 70 7d 20 7b 63 6c 6f 73 65 20 24 {s a p} {close $
8e50: 73 3b 20 65 72 72 6f 72 7d 0a 20 20 20 20 73 65 s; error}. se
8e60: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
8e70: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
8e80: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 39 38 5d 127.0.0.1 8898]
8e90: 0a 20 20 20 20 76 77 61 69 74 20 67 6f 74 65 72 . vwait goter
8ea0: 72 6f 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 ror. close $s
8eb0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 63 0a 20 20 . close $c.
8ec0: 20 20 73 65 74 20 67 6f 74 65 72 72 6f 72 0a 7d set goterror.}
8ed0: 20 31 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 1..test tlsIO-1
8ee0: 31 2e 31 20 7b 74 63 70 20 63 6f 6e 6e 65 63 74 1.1 {tcp connect
8ef0: 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 ion} {socket doT
8f00: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
8f10: 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 rver} {. send
8f20: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
8f30: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
8f40: 74 20 73 6f 63 6b 65 74 39 5f 31 5f 74 65 73 74 t socket9_1_test
8f50: 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f _server [tls::so
8f60: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
8f70: 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ept \...-certfil
8f80: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
8f90: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8fa0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
8fb0: 79 20 38 38 33 34 5d 0a 09 70 72 6f 63 20 61 63 y 8834]..proc ac
8fc0: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
8fd0: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
8fe0: 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 73 20 ke $s.. puts
8ff0: 24 73 20 64 6f 6e 65 0a 09 20 20 20 20 63 6c 6f $s done.. clo
9000: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
9010: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
9020: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9030: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9040: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9050: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9060: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9070: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
9080: 33 34 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 34]. set r [g
9090: 65 74 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 ets $s]. clos
90a0: 65 20 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d e $s. sendCom
90b0: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
90c0: 6b 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 ket9_1_test_serv
90d0: 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d 20 er}. set r.}
90e0: 64 6f 6e 65 0a 0a 74 65 73 74 20 74 6c 73 49 4f done..test tlsIO
90f0: 2d 31 31 2e 32 20 7b 63 6c 69 65 6e 74 20 73 70 -11.2 {client sp
9100: 65 63 69 66 69 65 73 20 69 74 73 20 70 6f 72 74 ecifies its port
9110: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
9120: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9130: 72 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 69 6e r} {. if {[in
9140: 66 6f 20 65 78 69 73 74 73 20 70 6f 72 74 5d 7d fo exists port]}
9150: 20 7b 0a 09 69 6e 63 72 20 70 6f 72 74 0a 20 20 {..incr port.
9160: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
9170: 70 6f 72 74 20 5b 65 78 70 72 20 7b 24 74 6c 73 port [expr {$tls
9180: 53 65 72 76 65 72 50 6f 72 74 20 2b 20 5b 70 69 ServerPort + [pi
9190: 64 5d 25 31 30 32 34 7d 5d 0a 20 20 20 20 7d 0a d]%1024}]. }.
91a0: 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 sendCertValu
91b0: 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 es. sendComma
91c0: 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b 65 74 nd {..set socket
91d0: 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 20 9_2_test_server
91e0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
91f0: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 rver accept \...
9200: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
9210: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
9220: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
9230: 73 65 72 76 65 72 4b 65 79 20 38 38 33 35 5d 0a serverKey 8835].
9240: 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 .proc accept {s
9250: 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a a p} {.. tls:
9260: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 :handshake $s..
9270: 20 20 20 70 75 74 73 20 24 73 20 24 70 0a 09 20 puts $s $p..
9280: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
9290: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
92a0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
92b0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
92c0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
92d0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
92e0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
92f0: 20 20 20 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 -myport $por
9300: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
9310: 50 20 38 38 33 35 5d 0a 20 20 20 20 73 65 74 20 P 8835]. set
9320: 72 20 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 r [gets $s].
9330: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 6e close $s. sen
9340: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
9350: 24 73 6f 63 6b 65 74 39 5f 32 5f 74 65 73 74 5f $socket9_2_test_
9360: 73 65 72 76 65 72 7d 0a 20 20 20 20 69 66 20 7b server}. if {
9370: 24 72 20 3d 3d 20 24 70 6f 72 74 7d 20 7b 0a 09 $r == $port} {..
9380: 73 65 74 20 72 65 73 75 6c 74 20 6f 6b 0a 20 20 set result ok.
9390: 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 } else {..set
93a0: 72 65 73 75 6c 74 20 62 72 6f 6b 65 6e 0a 20 20 result broken.
93b0: 20 20 7d 0a 20 20 20 20 73 65 74 20 72 65 73 75 }. set resu
93c0: 6c 74 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c lt.} ok..test tl
93d0: 73 49 4f 2d 31 31 2e 33 20 7b 74 72 79 69 6e 67 sIO-11.3 {trying
93e0: 20 74 6f 20 63 6f 6e 6e 65 63 74 2c 20 6e 6f 20 to connect, no
93f0: 73 65 72 76 65 72 7d 20 7b 73 6f 63 6b 65 74 20 server} {socket
9400: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
9410: 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 eServer} {. s
9420: 65 74 20 73 74 61 74 75 73 20 6f 6b 0a 20 20 20 et status ok.
9430: 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 73 65 if {![catch {se
9440: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
9450: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
9460: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
9470: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
9480: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
9490: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
94a0: 53 65 72 76 65 72 49 70 20 38 38 33 36 5d 7d 5d ServerIp 8836]}]
94b0: 7d 20 7b 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 } {..if {![catch
94c0: 20 7b 67 65 74 73 20 24 73 7d 5d 7d 20 7b 0a 09 {gets $s}]} {..
94d0: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 62 set status b
94e0: 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 roken..}..close
94f0: 24 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 $s. }. set
9500: 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a 0a 74 65 status.} ok..te
9510: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 34 20 7b 72 st tlsIO-11.4 {r
9520: 65 6d 6f 74 65 20 65 63 68 6f 2c 20 6f 6e 65 20 emote echo, one
9530: 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 64 6f line} {socket do
9540: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
9550: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
9560: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
9570: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
9580: 65 74 20 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 et socket10_6_te
9590: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
95a0: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
95b0: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
95c0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
95d0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
95e0: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
95f0: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 accept 8836]..p
9600: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
9610: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
9620: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
9630: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
9640: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 adable [list ech
9650: 6f 20 24 73 5d 0a 09 20 20 20 20 66 63 6f 6e 66 o $s].. fconf
9660: 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 igure $s -buffer
9670: 69 6e 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c ing line -transl
9680: 61 74 69 6f 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 ation crlf..}..p
9690: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
96a0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
96b0: 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f $s].. if {[eo
96c0: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
96d0: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 $s.. } else
96e0: 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 {...puts $s $l..
96f0: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
9700: 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 set f [tls::s
9710: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
9720: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
9730: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
9740: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
9750: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 entKey \.. $r
9760: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 emoteServerIP 88
9770: 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 36]. fconfigu
9780: 72 65 20 24 66 20 2d 74 72 61 6e 73 6c 61 74 69 re $f -translati
9790: 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 65 72 69 on crlf -bufferi
97a0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 75 74 73 ng line. puts
97b0: 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 73 65 $f hello. se
97c0: 74 20 72 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 t r [gets $f].
97d0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
97e0: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 endCommand {clos
97f0: 65 20 24 73 6f 63 6b 65 74 31 30 5f 36 5f 74 65 e $socket10_6_te
9800: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 st_server}. s
9810: 65 74 20 72 0a 7d 20 68 65 6c 6c 6f 0a 0a 74 65 et r.} hello..te
9820: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 35 20 7b 72 st tlsIO-11.5 {r
9830: 65 6d 6f 74 65 20 65 63 68 6f 2c 20 35 30 20 6c emote echo, 50 l
9840: 69 6e 65 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f ines} {socket do
9850: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
9860: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e erver} {. sen
9870: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
9880: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 sendCommand {..s
9890: 65 74 20 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 et socket10_7_te
98a0: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
98b0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
98c0: 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 ccept \...-certf
98d0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
98e0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
98f0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
9900: 4b 65 79 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 Key 8836]..proc
9910: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
9920: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
9930: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c hake $s.. fil
9940: 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 eevent $s readab
9950: 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 le [list echo $s
9960: 5d 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 ].. fconfigur
9970: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
9980: 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f line -translatio
9990: 6e 20 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 n crlf..}..proc
99a0: 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 echo {s} {..
99b0: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
99c0: 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 . if {[eof $s
99d0: 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a ]} {...close $s.
99e0: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
99f0: 70 75 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 puts $s $l..
9a00: 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 }..}. }. s
9a10: 65 74 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 et f [tls::socke
9a20: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
9a30: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
9a40: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
9a50: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
9a60: 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 ey \.. $remot
9a70: 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a eServerIP 8836].
9a80: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
9a90: 66 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 f -translation c
9aa0: 72 6c 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c rlf -buffering l
9ab0: 69 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 ine. for {set
9ac0: 20 63 6e 74 20 30 7d 20 7b 24 63 6e 74 20 3c 20 cnt 0} {$cnt <
9ad0: 35 30 7d 20 7b 69 6e 63 72 20 63 6e 74 7d 20 7b 50} {incr cnt} {
9ae0: 0a 09 70 75 74 73 20 24 66 20 22 68 65 6c 6c 6f ..puts $f "hello
9af0: 2c 20 24 63 6e 74 22 0a 09 69 66 20 7b 5b 67 65 , $cnt"..if {[ge
9b00: 74 73 20 24 66 5d 20 6e 65 20 22 68 65 6c 6c 6f ts $f] ne "hello
9b10: 2c 20 24 63 6e 74 22 7d 20 7b 0a 09 20 20 20 20 , $cnt"} {..
9b20: 62 72 65 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 break..}. }.
9b30: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
9b40: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f sendCommand {clo
9b50: 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 37 5f 74 se $socket10_7_t
9b60: 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 est_server}.
9b70: 73 65 74 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 set cnt.} 50..#
9b80: 4d 61 63 69 6e 74 6f 73 68 20 73 6f 63 6b 65 74 Macintosh socket
9b90: 73 20 63 61 6e 20 68 61 76 65 20 6d 6f 72 65 20 s can have more
9ba0: 74 68 61 6e 20 6f 6e 65 20 73 65 72 76 65 72 20 than one server
9bb0: 70 65 72 20 70 6f 72 74 0a 69 66 20 7b 24 74 63 per port.if {$tc
9bc0: 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 l_platform(platf
9bd0: 6f 72 6d 29 20 65 71 20 22 6d 61 63 69 6e 74 6f orm) eq "macinto
9be0: 73 68 22 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 sh"} {. set c
9bf0: 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 20 7b 30 onflictResult {0
9c00: 20 38 38 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 8836}.} else {.
9c10: 20 20 20 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 set conflict
9c20: 52 65 73 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 Result {1 {could
9c30: 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a n't open socket:
9c40: 20 61 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 address already
9c50: 20 69 6e 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 in use}}.}..tes
9c60: 74 20 74 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 6f t tlsIO-11.6 {so
9c70: 63 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b cket conflict} {
9c80: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9c90: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9ca0: 7b 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c {. set s1 [tl
9cb0: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
9cc0: 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 -certfile $serv
9cd0: 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 erCert -cafile $
9ce0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
9cf0: 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 $serverKey \..
9d00: 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 -server accept
9d10: 20 38 38 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b 8836]. if {[
9d20: 63 61 74 63 68 20 7b 73 65 74 20 73 32 20 5b 74 catch {set s2 [t
9d30: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9d40: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
9d50: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
9d60: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9d70: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
9d80: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
9d90: 74 20 38 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b t 8836]} msg]} {
9da0: 0a 09 73 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 ..set result [li
9db0: 73 74 20 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d st 1 $msg]. }
9dc0: 20 65 6c 73 65 20 7b 0a 09 73 65 74 20 72 65 73 else {..set res
9dd0: 75 6c 74 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e ult [list 0 [lin
9de0: 64 65 78 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 dex [fconfigure
9df0: 24 73 32 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 $s2 -sockname] 2
9e00: 5d 5d 0a 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 ]]..close $s2.
9e10: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 }. close $s
9e20: 31 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 1. set result
9e30: 0a 7d 20 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 .} $conflictResu
9e40: 6c 74 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 lt..test tlsIO-1
9e50: 31 2e 37 20 7b 73 65 72 76 65 72 20 77 69 74 68 1.7 {server with
9e60: 20 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 several clients
9e70: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
9e80: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9e90: 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 r} {. sendCer
9ea0: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
9eb0: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
9ec0: 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 ocket10_9_test_s
9ed0: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
9ee0: 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 et \...-certfile
9ef0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
9f00: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9f10: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
9f20: 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 \...-server acc
9f30: 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 ept 8836]..proc
9f40: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
9f50: 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 .. fconfigure
9f60: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
9f70: 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 ine.. fileeve
9f80: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b nt $s readable [
9f90: 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d list echo $s]..}
9fa0: 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 ..proc echo {s}
9fb0: 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 {.. set l [ge
9fc0: 74 73 20 24 73 5d 0a 09 20 20 20 20 69 66 20 7b ts $s].. if {
9fd0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c [eof $s]} {...cl
9fe0: 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c ose $s.. } el
9ff0: 73 65 20 7b 0a 09 09 70 75 74 73 20 24 73 20 24 se {...puts $s $
a000: 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 l.. }..}.
a010: 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c }. set s1 [tl
a020: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
a030: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
a040: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
a050: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a060: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
a070: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
a080: 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e P 8836]. fcon
a090: 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 66 66 figure $s1 -buff
a0a0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 ering line. s
a0b0: 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b et s2 [tls::sock
a0c0: 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 et \.. -certf
a0d0: 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 ile $clientCert
a0e0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
a0f0: 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 -keyfile $client
a100: 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f Key \.. $remo
a110: 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 5d teServerIP 8836]
a120: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
a130: 24 73 32 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s2 -buffering l
a140: 69 6e 65 0a 20 20 20 20 73 65 74 20 73 33 20 5b ine. set s3 [
a150: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
a160: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
a170: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
a180: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
a190: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
a1a0: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
a1b0: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 rIP 8836]. fc
a1c0: 6f 6e 66 69 67 75 72 65 20 24 73 33 20 2d 62 75 onfigure $s3 -bu
a1d0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
a1e0: 20 66 6f 72 20 7b 73 65 74 20 69 20 30 7d 20 7b for {set i 0} {
a1f0: 24 69 20 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 $i < 100} {incr
a200: 69 7d 20 7b 0a 09 70 75 74 73 20 24 73 31 20 68 i} {..puts $s1 h
a210: 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c ello,tlsIO-11.7,
a220: 73 31 0a 09 67 65 74 73 20 24 73 31 0a 09 70 75 s1..gets $s1..pu
a230: 74 73 20 24 73 32 20 68 65 6c 6c 6f 2c 74 6c 73 ts $s2 hello,tls
a240: 49 4f 2d 31 31 2e 37 2c 73 32 0a 09 67 65 74 73 IO-11.7,s2..gets
a250: 20 24 73 32 0a 09 70 75 74 73 20 24 73 33 20 68 $s2..puts $s3 h
a260: 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c ello,tlsIO-11.7,
a270: 73 33 0a 09 67 65 74 73 20 24 73 33 0a 20 20 20 s3..gets $s3.
a280: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 }. close $s1
a290: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 . close $s2.
a2a0: 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 close $s3.
a2b0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
a2c0: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f ose $socket10_9_
a2d0: 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 test_server}.
a2e0: 20 73 65 74 20 69 0a 7d 20 31 30 30 0a 0a 74 65 set i.} 100..te
a2f0: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 38 20 7b 63 st tlsIO-11.8 {c
a300: 6c 69 65 6e 74 20 77 69 74 68 20 73 65 76 65 72 lient with sever
a310: 61 6c 20 73 65 72 76 65 72 73 7d 20 7b 73 6f 63 al servers} {soc
a320: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
a330: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
a340: 20 20 20 73 65 6e 64 43 65 72 74 56 61 6c 75 65 sendCertValue
a350: 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e s. sendComman
a360: 64 20 7b 0a 09 74 6c 73 3a 3a 69 6e 69 74 20 2d d {..tls::init -
a370: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
a380: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
a390: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
a3a0: 65 72 76 65 72 4b 65 79 0a 09 73 65 74 20 73 31 erverKey..set s1
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 33 22 20 34 30 30 33 5d 0a 09 73 65 74 20 73 03" 4003]..set s
a3e0: 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 2 [tls::socket -
a3f0: 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 34 server "accept 4
a400: 30 30 34 22 20 34 30 30 34 5d 0a 09 73 65 74 20 004" 4004]..set
a410: 73 33 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s3 [tls::socket
a420: 2d 73 65 72 76 65 72 20 22 61 63 63 65 70 74 20 -server "accept
a430: 34 30 30 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 4005" 4005]..pro
a440: 63 20 68 61 6e 64 73 68 61 6b 65 20 7b 73 20 6d c handshake {s m
a450: 70 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 p} {.. if {[e
a460: 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 of $s]} {...clos
a470: 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 e $s.. } else
a480: 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a if {[catch {tls:
a490: 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 :handshake $s} r
a4a0: 65 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f esult]} {...# So
a4b0: 6d 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e 6f me errors are no
a4c0: 72 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 rmal... } els
a4d0: 65 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 eif {$result ==
a4e0: 31 7d 20 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 1} {...# Handsha
a4f0: 6b 65 20 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 ke complete...fi
a500: 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 leevent $s reada
a510: 62 6c 65 20 22 22 0a 09 09 70 75 74 73 20 24 73 ble ""...puts $s
a520: 20 24 6d 70 0a 09 09 63 6c 6f 73 65 20 24 73 0a $mp...close $s.
a530: 09 20 20 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 . }..}..proc
a540: 61 63 63 65 70 74 20 7b 6d 70 20 73 20 61 20 70 accept {mp s a p
a550: 7d 20 7b 0a 09 20 20 20 20 23 20 54 68 65 73 65 } {.. # These
a560: 20 68 61 76 65 20 74 6f 20 61 63 63 65 70 74 20 have to accept
a570: 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 2c 20 62 65 non-blocking, be
a580: 63 61 75 73 65 20 74 68 65 20 68 61 6e 64 73 68 cause the handsh
a590: 61 6b 69 6e 67 0a 09 20 20 20 20 23 20 6f 72 64 aking.. # ord
a5a0: 65 72 20 69 73 6e 27 74 20 64 65 74 65 72 6d 69 er isn't determi
a5b0: 6e 69 73 74 69 63 0a 09 20 20 20 20 66 63 6f 6e nistic.. fcon
a5c0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
a5d0: 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 ing 0 -buffering
a5e0: 20 6c 69 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 line.. filee
a5f0: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
a600: 20 5b 6c 69 73 74 20 68 61 6e 64 73 68 61 6b 65 [list handshake
a610: 20 24 73 20 24 6d 70 5d 0a 09 7d 0a 20 20 20 20 $s $mp]..}.
a620: 7d 0a 20 20 20 20 74 6c 73 3a 3a 69 6e 69 74 20 }. tls::init
a630: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
a640: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
a650: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
a660: 63 6c 69 65 6e 74 4b 65 79 0a 20 20 20 20 73 65 clientKey. se
a670: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
a680: 74 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 t $remoteServerI
a690: 50 20 34 30 30 33 5d 0a 20 20 20 20 73 65 74 20 P 4003]. set
a6a0: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
a6b0: 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 $remoteServerIP
a6c0: 34 30 30 34 5d 0a 20 20 20 20 73 65 74 20 73 33 4004]. set s3
a6d0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 [tls::socket $r
a6e0: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 emoteServerIP 40
a6f0: 30 35 5d 0a 20 20 20 20 73 65 74 20 6c 20 22 22 05]. set l ""
a700: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
a710: 67 65 74 73 20 24 73 31 5d 20 5b 67 65 74 73 20 gets $s1] [gets
a720: 24 73 31 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b $s1] [eof $s1] [
a730: 67 65 74 73 20 24 73 32 5d 20 5b 67 65 74 73 20 gets $s2] [gets
a740: 24 73 32 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c $s2] [eof $s2] \
a750: 0a 09 5b 67 65 74 73 20 24 73 33 5d 20 5b 67 65 ..[gets $s3] [ge
a760: 74 73 20 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 ts $s3] [eof $s3
a770: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a ]. close $s1.
a780: 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 close $s2.
a790: 20 20 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 close $s3.
a7a0: 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 sendCommand {..c
a7b0: 6c 6f 73 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 lose $s1..close
a7c0: 24 73 32 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 $s2..close $s3.
a7d0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d }. set l.}
a7e0: 20 7b 34 30 30 33 20 7b 7d 20 31 20 34 30 30 34 {4003 {} 1 4004
a7f0: 20 7b 7d 20 31 20 34 30 30 35 20 7b 7d 20 31 7d {} 1 4005 {} 1}
a800: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
a810: 39 20 7b 61 63 63 65 70 74 20 63 61 6c 6c 62 61 9 {accept callba
a820: 63 6b 20 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 ck error} {socke
a830: 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d t doTestsWithRem
a840: 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 oteServer} {.
a850: 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 set s [tls::soc
a860: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
a870: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
a880: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
a890: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
a8a0: 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 rKey \.. -ser
a8b0: 76 65 72 20 61 63 63 65 70 74 20 38 38 33 36 5d ver accept 8836]
a8c0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
a8d0: 20 7b 73 20 61 20 70 7d 20 7b 65 78 70 72 20 31 {s a p} {expr 1
a8e0: 30 20 2f 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 0 / 0}. proc
a8f0: 62 67 65 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 bgerror args {..
a900: 67 6c 6f 62 61 6c 20 78 0a 09 73 65 74 20 78 20 global x..set x
a910: 24 61 72 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 $args. }.
a920: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
a930: 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 if {[catch {s
a940: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 endCommand {..
a950: 20 20 73 65 74 20 70 65 65 72 6e 61 6d 65 20 5b set peername [
a960: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 61 6c 6c fconfigure $call
a970: 65 72 53 6f 63 6b 65 74 20 2d 70 65 65 72 6e 61 erSocket -peerna
a980: 6d 65 5d 0a 09 20 20 20 20 73 65 74 20 73 20 5b me].. set s [
a990: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 tls::socket \...
a9a0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 -certfile $c
a9b0: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
a9c0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
a9d0: 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a le $clientKey \.
a9e0: 09 09 20 20 20 20 5b 6c 69 6e 64 65 78 20 24 70 .. [lindex $p
a9f0: 65 65 72 6e 61 6d 65 20 30 5d 20 38 38 33 36 5d eername 0] 8836]
aa00: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 .. close $s.
aa10: 20 20 20 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a . }} msg]} {.
aa20: 09 63 6c 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 .close $s..error
aa30: 20 24 6d 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 $msg. }.
aa40: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
aa50: 20 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 10000 "set x ti
aa60: 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 med_out"]. vw
aa70: 61 69 74 20 78 0a 20 20 20 20 61 66 74 65 72 20 ait x. after
aa80: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 cancel $timer.
aa90: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 close $s. r
aaa0: 65 6e 61 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d ename bgerror {}
aab0: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 . set x.} {{d
aac0: 69 76 69 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a ivide by zero}}.
aad0: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 .test tlsIO-11.1
aae0: 30 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 0 {testing socke
aaf0: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
ab00: 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ns} {socket doTe
ab10: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
ab20: 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 ver} {. sendC
ab30: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
ab40: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
ab50: 20 73 6f 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 socket10_12_tes
ab60: 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 t_server [tls::s
ab70: 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 ocket \...-certf
ab80: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
ab90: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
aba0: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
abb0: 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 Key \...-server
abc0: 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 accept 8836]..pr
abd0: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
abe0: 7d 20 7b 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 } {close $s}.
abf0: 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c }. set s [tl
ac00: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
ac10: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
ac20: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
ac30: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
ac40: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
ac50: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
ac60: 50 20 38 38 33 36 5d 0a 20 20 20 20 73 65 74 20 P 8836]. set
ac70: 70 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 p [fconfigure $s
ac80: 20 2d 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 -peername].
ac90: 73 65 74 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 set n [fconfigur
aca0: 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a e $s -sockname].
acb0: 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 set l "".
acc0: 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 lappend l [lind
acd0: 65 78 20 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 ex $p 2] [llengt
ace0: 68 20 24 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 h $p] [llength $
acf0: 70 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a p]. close $s.
ad00: 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 sendCommand
ad10: 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 {close $socket10
ad20: 5f 31 32 5f 74 65 73 74 5f 73 65 72 76 65 72 7d _12_test_server}
ad30: 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 38 38 . set l.} {88
ad40: 33 36 20 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 36 3 3}..test tl
ad50: 73 49 4f 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 sIO-11.11 {testi
ad60: 6e 67 20 73 70 75 72 69 6f 75 73 20 65 76 65 6e ng spurious even
ad70: 74 73 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 ts} {socket doTe
ad80: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
ad90: 76 65 72 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d ver} {. # rem
ada0: 6f 74 65 20 65 71 75 69 76 61 6c 65 6e 74 20 6f ote equivalent o
adb0: 66 20 39 2e 31 0a 20 20 20 20 73 65 6e 64 43 65 f 9.1. sendCe
adc0: 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e rtValues. sen
add0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 dCommand {..set
ade0: 73 6f 63 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 socket_test_serv
adf0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
ae00: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c -server accept \
ae10: 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 ...-certfile $se
ae20: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
ae30: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
ae40: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
ae50: 36 5d 0a 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6]..proc handsha
ae60: 6b 65 20 7b 73 7d 20 7b 0a 09 20 20 20 20 69 66 ke {s} {.. if
ae70: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 {[eof $s]} {...
ae80: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 20 close $s.. }
ae90: 65 6c 73 65 69 66 20 7b 5b 63 61 74 63 68 20 7b elseif {[catch {
aea0: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
aeb0: 73 7d 20 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 09 s} result]} {...
aec0: 23 20 53 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 # Some errors ar
aed0: 65 20 6e 6f 72 6d 61 6c 2e 0a 09 20 20 20 20 7d e normal... }
aee0: 20 65 6c 73 65 69 66 20 7b 24 72 65 73 75 6c 74 elseif {$result
aef0: 20 3d 3d 20 31 7d 20 7b 0a 09 09 23 20 48 61 6e == 1} {...# Han
af00: 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a dshake complete.
af10: 09 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 ..fileevent $s w
af20: 72 69 74 61 62 6c 65 20 22 22 0a 09 09 61 66 74 ritable ""...aft
af30: 65 72 20 31 30 30 20 77 72 69 74 65 73 6f 6d 65 er 100 writesome
af40: 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 70 $s.. }..}..p
af50: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
af60: 70 7d 20 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 p} {.. fconfi
af70: 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 gure $s -transla
af80: 74 69 6f 6e 20 22 61 75 74 6f 20 6c 66 22 0a 09 tion "auto lf"..
af90: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
afa0: 20 77 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 writable [list
afb0: 68 61 6e 64 73 68 61 6b 65 20 24 73 5d 0a 09 7d handshake $s]..}
afc0: 0a 09 70 72 6f 63 20 77 72 69 74 65 73 6f 6d 65 ..proc writesome
afd0: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 {s} {.. for
afe0: 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 {set i 0} {$i <
aff0: 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 100} {incr i} {.
b000: 09 09 70 75 74 73 20 24 73 20 22 6c 69 6e 65 20 ..puts $s "line
b010: 24 69 20 66 72 6f 6d 20 72 65 6d 6f 74 65 20 73 $i from remote s
b020: 65 72 76 65 72 22 0a 09 20 20 20 20 7d 0a 09 20 erver".. }..
b030: 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 close $s..}.
b040: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e }. set len
b050: 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 0. set spuri
b060: 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f ous 0. set do
b070: 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 ne 0. proc re
b080: 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 adlittle {s} {..
b090: 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 global spurious
b0a0: 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 done len..set l
b0b0: 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 [read $s 1]..if
b0c0: 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 {[string length
b0d0: 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 $l] == 0} {..
b0e0: 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 if {![eof $s]}
b0f0: 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 {...incr spuriou
b100: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a s.. } else {.
b110: 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 ..close $s...set
b120: 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 done 1.. }..
b130: 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e } else {.. in
b140: 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c cr len [string l
b150: 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 ength $l]..}.
b160: 20 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 6c }. set c [tl
b170: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 s::socket \..
b180: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
b190: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
b1a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
b1b0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 $clientKey \..
b1c0: 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 $remoteServerI
b1d0: 50 20 38 38 33 36 5d 0a 20 20 20 20 23 20 47 65 P 8836]. # Ge
b1e0: 74 20 74 68 65 20 62 75 66 66 65 72 69 6e 67 20 t the buffering
b1f0: 63 6f 72 72 65 63 74 65 64 0a 20 20 20 20 66 63 corrected. fc
b200: 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 75 66 onfigure $c -buf
b210: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
b220: 23 20 50 75 74 20 61 20 62 79 74 65 20 69 6e 74 # Put a byte int
b230: 6f 20 74 68 65 20 63 6c 69 65 6e 74 20 70 69 70 o the client pip
b240: 65 20 74 6f 20 74 72 69 67 67 65 72 20 54 4c 53 e to trigger TLS
b250: 20 68 61 6e 64 73 68 61 6b 69 6e 67 0a 20 20 20 handshaking.
b260: 20 70 75 74 73 20 24 63 20 61 0a 20 20 20 20 66 puts $c a. f
b270: 69 6c 65 65 76 65 6e 74 20 24 63 20 72 65 61 64 ileevent $c read
b280: 61 62 6c 65 20 5b 6c 69 73 74 20 72 65 61 64 6c able [list readl
b290: 69 74 74 6c 65 20 24 63 5d 0a 20 20 20 20 73 65 ittle $c]. se
b2a0: 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 t timer [after 1
b2b0: 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20 74 0000 "set done t
b2c0: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 imed_out"]. v
b2d0: 77 61 69 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 wait done. af
b2e0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
b2f0: 72 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e r. sendComman
b300: 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 d {close $socket
b310: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
b320: 20 20 6c 69 73 74 20 24 73 70 75 72 69 6f 75 73 list $spurious
b330: 20 24 6c 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d $len.} {0 2690}
b340: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
b350: 31 32 20 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 12 {testing EOF
b360: 73 74 69 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 stickyness} {une
b370: 78 70 6c 61 69 6e 65 64 46 61 69 6c 75 72 65 20 xplainedFailure
b380: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
b390: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
b3a0: 7b 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 20 65 {. # remote e
b3b0: 71 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 2e 33 quivalent of 9.3
b3c0: 0a 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 . # HOBBS: ne
b3d0: 76 65 72 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 ver worked corre
b3e0: 63 74 6c 79 0a 20 20 20 20 73 65 74 20 63 6f 75 ctly. set cou
b3f0: 6e 74 65 72 20 30 0a 20 20 20 20 73 65 74 20 64 nter 0. set d
b400: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 63 one 0. proc c
b410: 6f 75 6e 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 ount_up {s} {..g
b420: 6c 6f 62 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f lobal counter do
b430: 6e 65 20 61 66 74 65 72 5f 69 64 0a 09 73 65 74 ne after_id..set
b440: 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 l [gets $s]..if
b450: 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 {[eof $s]} {..
b460: 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a incr counter.
b470: 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 . if {$counte
b480: 72 20 3e 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 r > 9} {...set d
b490: 6f 6e 65 20 7b 45 4f 46 20 69 73 20 73 74 69 63 one {EOF is stic
b4a0: 6b 79 7d 0a 09 09 61 66 74 65 72 20 63 61 6e 63 ky}...after canc
b4b0: 65 6c 20 24 61 66 74 65 72 5f 69 64 0a 09 09 63 el $after_id...c
b4c0: 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 lose $s.. }..
b4d0: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 }. }. proc
b4e0: 20 74 69 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a timed_out {} {.
b4f0: 09 67 6c 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 .global c done..
b500: 73 65 74 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f set done {timed_
b510: 6f 75 74 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 out, EOF is not
b520: 73 74 69 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 sticky}..close $
b530: 63 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 c. }. send
b540: 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 CertValues. s
b550: 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 endCommand {..se
b560: 74 20 73 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 t socket10_14_te
b570: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
b580: 73 6f 63 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 socket \...-cert
b590: 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 file $serverCert
b5a0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
b5b0: 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 -keyfile $serve
b5c0: 72 4b 65 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 rKey \...-server
b5d0: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 09 70 accept 8836]..p
b5e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
b5f0: 70 7d 20 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 p} {.. tls::h
b600: 61 6e 64 73 68 61 6b 65 20 24 73 0a 09 20 20 20 andshake $s..
b610: 20 61 66 74 65 72 20 31 30 30 20 63 6c 6f 73 65 after 100 close
b620: 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 $s..}. }.
b630: 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 set c [tls::soc
b640: 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 ket \.. -cert
b650: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
b660: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
b670: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
b680: 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 72 65 6d tKey \.. $rem
b690: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 36 oteServerIP 8836
b6a0: 5d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 ]. fileevent
b6b0: 24 63 20 72 65 61 64 61 62 6c 65 20 22 63 6f 75 $c readable "cou
b6c0: 6e 74 5f 75 70 20 24 63 22 0a 20 20 20 20 73 65 nt_up $c". se
b6d0: 74 20 61 66 74 65 72 5f 69 64 20 5b 61 66 74 65 t after_id [afte
b6e0: 72 20 31 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 r 1000 timed_out
b6f0: 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e 65 ]. vwait done
b700: 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 . sendCommand
b710: 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 {close $socket1
b720: 30 5f 31 34 5f 74 65 73 74 5f 73 65 72 76 65 72 0_14_test_server
b730: 7d 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d }. set done.}
b740: 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d {EOF is sticky}
b750: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e ..test tlsIO-11.
b760: 31 33 20 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 13 {testing asyn
b770: 63 20 77 72 69 74 65 2c 20 61 73 79 6e 63 20 66 c write, async f
b780: 6c 75 73 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 lush, async clos
b790: 65 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f e} \..{socket do
b7a0: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
b7b0: 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f erver} {. pro
b7c0: 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 c readit {s} {..
b7d0: 67 6c 6f 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e global count don
b7e0: 65 0a 09 73 65 74 20 6c 20 5b 72 65 61 64 20 24 e..set l [read $
b7f0: 73 5d 0a 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b s]..incr count [
b800: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
b810: 5d 0a 09 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d ]..if {[eof $s]}
b820: 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 {.. close $s
b830: 0a 09 20 20 20 20 73 65 74 20 64 6f 6e 65 20 31 .. set done 1
b840: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
b850: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
b860: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
b870: 73 65 74 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b set firstblock [
b880: 73 74 72 69 6e 67 20 72 65 70 65 61 74 20 61 20 string repeat a
b890: 33 31 5d 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 31]..set secondb
b8a0: 6c 6f 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 lock [string rep
b8b0: 65 61 74 20 62 20 36 35 35 33 35 5d 0a 09 73 65 eat b 65535]..se
b8c0: 74 20 6c 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t l [tls::socket
b8d0: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
b8e0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
b8f0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
b900: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
b910: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
b920: 74 20 38 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 t 8845]..proc ac
b930: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
b940: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
b950: 6b 65 20 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 ke $s.. fconf
b960: 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 igure $s -blocki
b970: 6e 67 20 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f ng 0 -translatio
b980: 6e 20 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 n lf -buffersize
b990: 20 31 36 33 38 34 20 5c 0a 09 09 20 20 20 20 2d 16384 \... -
b9a0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 buffering line..
b9b0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
b9c0: 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 61 readable "reada
b9d0: 62 6c 65 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 ble $s"..}..proc
b9e0: 20 72 65 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a readable {s} {.
b9f0: 09 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 . set l [gets
ba00: 20 24 73 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 $s].. fileev
ba10: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
ba20: 7b 7d 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 {}.. after 10
ba30: 30 30 20 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 00 respond $s..}
ba40: 0a 09 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b ..proc respond {
ba50: 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c s} {.. global
ba60: 20 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 firstblock..
ba70: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
ba80: 20 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a $s $firstblock.
ba90: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
baa0: 77 72 69 74 65 64 61 74 61 20 24 73 0a 09 7d 0a writedata $s..}.
bab0: 09 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 20 .proc writedata
bac0: 7b 73 7d 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 {s} {.. globa
bad0: 6c 20 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 l secondblock..
bae0: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 puts -nonewli
baf0: 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f ne $s $secondblo
bb00: 63 6b 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 ck.. close $s
bb10: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
bb20: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
bb30: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
bb40: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
bb50: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
bb60: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
bb70: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
bb80: 53 65 72 76 65 72 49 50 20 38 38 34 35 5d 0a 20 ServerIP 8845].
bb90: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
bba0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 -blocking 0 -tr
bbb0: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 anslation lf -bu
bbc0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
bbd0: 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 set count 0.
bbe0: 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 puts $s hello.
bbf0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 fileevent $s
bc00: 72 65 61 64 61 62 6c 65 20 22 72 65 61 64 69 74 readable "readit
bc10: 20 24 73 22 0a 20 20 20 20 73 65 74 20 74 69 6d $s". set tim
bc20: 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 er [after 10000
bc30: 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f "set done timed_
bc40: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
bc50: 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 done. after c
bc60: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 ancel $timer.
bc70: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
bc80: 6f 73 65 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 ose $l}. set
bc90: 63 6f 75 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 70 count.} 65566..p
bca0: 72 6f 63 20 67 65 74 64 61 74 61 20 7b 74 79 70 roc getdata {typ
bcb0: 65 20 66 69 6c 65 7d 20 7b 0a 20 20 20 20 23 20 e file} {. #
bcc0: 52 65 61 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 Read handler on
bcd0: 74 68 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 the accepted soc
bce0: 6b 65 74 2e 0a 20 20 20 20 67 6c 6f 62 61 6c 20 ket.. global
bcf0: 78 0a 20 20 20 20 67 6c 6f 62 61 6c 20 66 61 69 x. global fai
bd00: 6c 65 64 0a 20 20 20 20 73 65 74 20 73 74 61 74 led. set stat
bd10: 75 73 20 5b 63 61 74 63 68 20 7b 72 65 61 64 20 us [catch {read
bd20: 24 66 69 6c 65 7d 20 64 61 74 61 5d 0a 20 20 20 $file} data].
bd30: 20 69 66 20 7b 24 73 74 61 74 75 73 20 21 3d 20 if {$status !=
bd40: 30 7d 20 7b 0a 09 73 65 74 20 78 20 22 72 65 61 0} {..set x "rea
bd50: 64 20 66 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 d failed, error
bd60: 77 61 73 20 24 64 61 74 61 22 0a 09 63 61 74 63 was $data"..catc
bd70: 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 h { close $file
bd80: 7d 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b }. } elseif {
bd90: 24 64 61 74 61 20 6e 65 20 7b 7d 7d 20 7b 0a 20 $data ne {}} {.
bda0: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 66 62 } elseif {[fb
bdb0: 6c 6f 63 6b 65 64 20 24 66 69 6c 65 5d 7d 20 7b locked $file]} {
bdc0: 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b . } elseif {[
bdd0: 65 6f 66 20 24 66 69 6c 65 5d 7d 20 7b 0a 09 69 eof $file]} {..i
bde0: 66 20 7b 24 66 61 69 6c 65 64 7d 20 7b 0a 09 20 f {$failed} {..
bdf0: 20 20 20 73 65 74 20 78 20 22 24 74 79 70 65 20 set x "$type
be00: 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 socket was inher
be10: 69 74 65 64 22 0a 09 7d 20 65 6c 73 65 20 7b 0a ited"..} else {.
be20: 09 20 20 20 20 73 65 74 20 78 20 22 24 74 79 70 . set x "$typ
be30: 65 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 e socket was not
be40: 20 69 6e 68 65 72 69 74 65 64 22 0a 09 7d 0a 09 inherited"..}..
be50: 63 61 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 catch { close $f
be60: 69 6c 65 20 7d 0a 20 20 20 20 7d 20 65 6c 73 65 ile }. } else
be70: 20 7b 0a 09 73 65 74 20 78 20 7b 69 6d 70 6f 73 {..set x {impos
be80: 73 69 62 6c 65 20 63 61 73 65 7d 0a 09 63 61 74 sible case}..cat
be90: 63 68 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 ch { close $file
bea0: 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 }. }. ret
beb0: 75 72 6e 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 urn.}..test tlsI
bec0: 4f 2d 31 32 2e 31 20 7b 74 65 73 74 69 6e 67 20 O-12.1 {testing
bed0: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 73 inheritance of s
bee0: 65 72 76 65 72 20 73 6f 63 6b 65 74 73 7d 20 7b erver sockets} {
bef0: 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 socket exec} {.
bf00: 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 makeFile {} s
bf10: 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 cript1. makeF
bf20: 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a ile {} script2..
bf30: 20 20 20 20 23 20 53 63 72 69 70 74 31 20 69 73 # Script1 is
bf40: 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e just a 10 secon
bf50: 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 d delay. If the
bf60: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 server socket.
bf70: 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 # is inherite
bf80: 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 d, it will be he
bf90: 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 ld open for 10 s
bfa0: 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 econds.. set
bfb0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 f [open script1
bfc0: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
bfd0: 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 ..after 10000 ex
bfe0: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
bff0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
c000: 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 e $f.. # Scri
c010: 70 74 32 20 63 72 65 61 74 65 73 20 74 68 65 20 pt2 creates the
c020: 73 65 72 76 65 72 20 73 6f 63 6b 65 74 2c 20 6c server socket, l
c030: 61 75 6e 63 68 65 73 20 73 63 72 69 70 74 31 2c aunches script1,
c040: 0a 20 20 20 20 23 20 77 61 69 74 73 20 61 20 73 . # waits a s
c050: 65 63 6f 6e 64 2c 20 61 6e 64 20 65 78 69 74 73 econd, and exits
c060: 2e 20 20 54 68 65 20 73 65 72 76 65 72 20 73 6f . The server so
c070: 63 6b 65 74 20 77 69 6c 6c 20 6e 6f 77 0a 20 20 cket will now.
c080: 20 20 23 20 62 65 20 63 6c 6f 73 65 64 20 75 6e # be closed un
c090: 6c 65 73 73 20 73 63 72 69 70 74 31 20 69 6e 68 less script1 inh
c0a0: 65 72 69 74 65 64 20 69 74 2e 0a 0a 20 20 20 20 erited it...
c0b0: 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 set f [open scri
c0c0: 70 74 32 20 77 5d 0a 20 20 20 20 70 75 74 73 20 pt2 w]. puts
c0d0: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 74 63 6c $f [list set tcl
c0e0: 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 sh $::tcltest::t
c0f0: 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 75 74 73 cltest]. puts
c100: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 $f [list set au
c110: 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 to_path $auto_pa
c120: 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 th]. puts $f
c130: 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 {..package requi
c140: 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 re tls. }.
c150: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
c160: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
c170: 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 erver accept \..
c180: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
c190: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
c1a0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
c1b0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
c1c0: 32 38 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 28\]". puts $
c1d0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
c1e0: 20 7b 20 66 69 6c 65 20 61 64 64 72 20 70 6f 72 { file addr por
c1f0: 74 20 7d 20 7b 0a 09 20 20 20 20 63 6c 6f 73 65 t } {.. close
c200: 20 24 66 69 6c 65 0a 09 7d 0a 09 65 78 65 63 20 $file..}..exec
c210: 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 $tclsh script1 &
c220: 0a 09 63 6c 6f 73 65 20 24 66 0a 09 61 66 74 65 ..close $f..afte
c230: 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 61 r 1000 exit..vwa
c240: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
c250: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 . close $f..
c260: 20 20 20 23 20 4c 61 75 6e 63 68 20 73 63 72 69 # Launch scri
c270: 70 74 32 20 61 6e 64 20 77 61 69 74 20 35 20 73 pt2 and wait 5 s
c280: 65 63 6f 6e 64 73 0a 0a 20 20 20 20 65 78 65 63 econds.. exec
c290: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
c2a0: 74 65 73 74 20 73 63 72 69 70 74 32 20 26 0a 20 test script2 &.
c2b0: 20 20 20 61 66 74 65 72 20 35 30 30 30 20 7b 20 after 5000 {
c2c0: 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 set ok_to_procee
c2d0: 64 20 31 20 7d 0a 20 20 20 20 76 77 61 69 74 20 d 1 }. vwait
c2e0: 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a 20 ok_to_proceed..
c2f0: 20 20 20 23 20 49 66 20 77 65 20 63 61 6e 20 73 # If we can s
c300: 74 69 6c 6c 20 63 6f 6e 6e 65 63 74 20 74 6f 20 till connect to
c310: 74 68 65 20 73 65 72 76 65 72 2c 20 74 68 65 20 the server, the
c320: 73 6f 63 6b 65 74 20 67 6f 74 20 69 6e 68 65 72 socket got inher
c330: 69 74 65 64 2e 0a 0a 20 20 20 20 69 66 20 7b 5b ited... if {[
c340: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
c350: 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 et \..-certfile
c360: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
c370: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
c380: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
c390: 5c 0a 20 20 20 09 20 31 32 37 2e 30 2e 30 2e 31 \. . 127.0.0.1
c3a0: 20 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 09 8828} msg]} {..
c3b0: 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 73 6f set x {server so
c3c0: 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 cket was not inh
c3d0: 65 72 69 74 65 64 7d 0a 20 20 20 20 7d 20 65 6c erited}. } el
c3e0: 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 67 se {..close $msg
c3f0: 0a 09 73 65 74 20 78 20 7b 73 65 72 76 65 72 20 ..set x {server
c400: 73 6f 63 6b 65 74 20 77 61 73 20 69 6e 68 65 72 socket was inher
c410: 69 74 65 64 7d 0a 20 20 20 20 7d 0a 0a 20 20 20 ited}. }..
c420: 20 73 65 74 20 78 0a 7d 20 7b 73 65 72 76 65 72 set x.} {server
c430: 20 73 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 socket was not
c440: 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 inherited}..test
c450: 20 74 6c 73 49 4f 2d 31 32 2e 32 20 7b 74 65 73 tlsIO-12.2 {tes
c460: 74 69 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 ting inheritance
c470: 20 6f 66 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 of client socke
c480: 74 73 7d 20 7b 73 6f 63 6b 65 74 20 65 78 65 63 ts} {socket exec
c490: 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 } {. makeFile
c4a0: 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 20 {} script1.
c4b0: 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 makeFile {} scri
c4c0: 70 74 32 0a 0a 20 20 20 20 23 20 53 63 72 69 70 pt2.. # Scrip
c4d0: 74 31 20 69 73 20 6a 75 73 74 20 61 20 31 30 20 t1 is just a 10
c4e0: 73 65 63 6f 6e 64 20 64 65 6c 61 79 2e 20 20 49 second delay. I
c4f0: 66 20 74 68 65 20 73 65 72 76 65 72 20 73 6f 63 f the server soc
c500: 6b 65 74 0a 20 20 20 20 23 20 69 73 20 69 6e 68 ket. # is inh
c510: 65 72 69 74 65 64 2c 20 69 74 20 77 69 6c 6c 20 erited, it will
c520: 62 65 20 68 65 6c 64 20 6f 70 65 6e 20 66 6f 72 be held open for
c530: 20 31 30 20 73 65 63 6f 6e 64 73 0a 0a 20 20 20 10 seconds..
c540: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
c550: 69 70 74 31 20 77 5d 0a 20 20 20 20 70 75 74 73 ipt1 w]. puts
c560: 20 24 66 20 7b 0a 09 61 66 74 65 72 20 31 30 30 $f {..after 100
c570: 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 00 exit..vwait f
c580: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
c590: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 close $f.. #
c5a0: 20 53 63 72 69 70 74 32 20 6f 70 65 6e 73 20 74 Script2 opens t
c5b0: 68 65 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 he client socket
c5c0: 20 61 6e 64 20 77 72 69 74 65 73 20 74 6f 20 69 and writes to i
c5d0: 74 2e 20 20 49 74 20 74 68 65 6e 0a 20 20 20 20 t. It then.
c5e0: 23 20 6c 61 75 6e 63 68 65 73 20 73 63 72 69 70 # launches scrip
c5f0: 74 31 20 61 6e 64 20 65 78 69 74 73 2e 20 20 49 t1 and exits. I
c600: 66 20 74 68 65 20 63 68 69 6c 64 20 70 72 6f 63 f the child proc
c610: 65 73 73 20 69 6e 68 65 72 69 74 65 64 20 74 68 ess inherited th
c620: 65 0a 20 20 20 20 23 20 63 6c 69 65 6e 74 20 73 e. # client s
c630: 6f 63 6b 65 74 2c 20 74 68 65 20 73 6f 63 6b 65 ocket, the socke
c640: 74 20 77 69 6c 6c 20 73 74 69 6c 6c 20 62 65 20 t will still be
c650: 6f 70 65 6e 2e 0a 0a 20 20 20 20 73 65 74 20 66 open... set f
c660: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 [open script2 w
c670: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
c680: 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a ist set tclsh $:
c690: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
c6a0: 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b t]. puts $f [
c6b0: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
c6c0: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
c6d0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
c6e0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
c6f0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
c700: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
c710: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
c720: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
c730: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
c740: 0a 09 20 20 20 20 2d 6b 65 79 66 69 6c 65 20 24 .. -keyfile $
c750: 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e clientKey 127.0.
c760: 30 2e 31 20 38 38 32 39 5c 5d 22 0a 20 20 20 20 0.1 8829\]".
c770: 70 75 74 73 20 24 66 20 7b 0a 09 65 78 65 63 20 puts $f {..exec
c780: 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 26 $tclsh script1 &
c790: 0a 09 70 75 74 73 20 24 66 20 74 65 73 74 69 6e ..puts $f testin
c7a0: 67 0a 09 66 6c 75 73 68 20 24 66 0a 09 61 66 74 g..flush $f..aft
c7b0: 65 72 20 31 30 30 30 20 65 78 69 74 0a 09 76 77 er 1000 exit..vw
c7c0: 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 ait forever.
c7d0: 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a }. close $f..
c7e0: 20 20 20 20 23 20 43 72 65 61 74 65 20 74 68 65 # Create the
c7f0: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 0a server socket..
c800: 20 20 20 20 73 65 74 20 73 65 72 76 65 72 20 5b set server [
c810: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
c820: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
c830: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
c840: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
c850: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
c860: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
c870: 70 74 20 38 38 32 39 5d 0a 20 20 20 20 70 72 6f pt 8829]. pro
c880: 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 c accept { file
c890: 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 23 host port } {..#
c8a0: 20 57 68 65 6e 20 74 68 65 20 63 6c 69 65 6e 74 When the client
c8b0: 20 63 6f 6e 6e 65 63 74 73 2c 20 65 73 74 61 62 connects, estab
c8c0: 6c 69 73 68 20 74 68 65 20 72 65 61 64 20 68 61 lish the read ha
c8d0: 6e 64 6c 65 72 0a 09 67 6c 6f 62 61 6c 20 73 65 ndler..global se
c8e0: 72 76 65 72 0a 09 63 6c 6f 73 65 20 24 73 65 72 rver..close $ser
c8f0: 76 65 72 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 ver..fconfigure
c900: 24 66 69 6c 65 20 2d 62 6c 6f 63 6b 69 6e 67 20 $file -blocking
c910: 30 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 66 69 0..fileevent $fi
c920: 6c 65 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 le readable [lis
c930: 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 t do_handshake $
c940: 66 69 6c 65 20 72 65 61 64 61 62 6c 65 20 5c 0a file readable \.
c950: 09 09 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 ..[list getdata
c960: 63 6c 69 65 6e 74 5d 20 2d 62 75 66 66 65 72 69 client] -bufferi
c970: 6e 67 20 6c 69 6e 65 5d 0a 09 72 65 74 75 72 6e ng line]..return
c980: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 23 20 49 66 . }.. # If
c990: 20 74 68 65 20 73 6f 63 6b 65 74 20 64 6f 65 73 the socket does
c9a0: 6e 27 74 20 68 69 74 20 65 6e 64 2d 6f 66 2d 66 n't hit end-of-f
c9b0: 69 6c 65 20 69 6e 20 35 20 73 65 63 6f 6e 64 73 ile in 5 seconds
c9c0: 2c 20 74 68 65 0a 20 20 20 20 23 20 73 63 72 69 , the. # scri
c9d0: 70 74 31 20 70 72 6f 63 65 73 73 20 6d 75 73 74 pt1 process must
c9e0: 20 68 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 have inherited
c9f0: 74 68 65 20 63 6c 69 65 6e 74 2e 0a 0a 20 20 20 the client...
ca00: 20 73 65 74 20 66 61 69 6c 65 64 20 30 0a 20 20 set failed 0.
ca10: 20 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 after 5000 [li
ca20: 73 74 20 73 65 74 20 66 61 69 6c 65 64 20 31 5d st set failed 1]
ca30: 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 .. # Launch t
ca40: 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 he script2 proce
ca50: 73 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a ss.. exec $::
ca60: 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 tcltest::tcltest
ca70: 20 73 63 72 69 70 74 32 20 26 0a 0a 20 20 20 20 script2 &..
ca80: 76 77 61 69 74 20 78 0a 20 20 20 20 69 66 20 7b vwait x. if {
ca90: 21 24 66 61 69 6c 65 64 7d 20 7b 0a 09 76 77 61 !$failed} {..vwa
caa0: 69 74 20 66 61 69 6c 65 64 0a 20 20 20 20 7d 0a it failed. }.
cab0: 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6c 69 set x.} {cli
cac0: 65 6e 74 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ent socket was n
cad0: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 ot inherited}..t
cae0: 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e 33 20 7b est tlsIO-12.3 {
caf0: 74 65 73 74 69 6e 67 20 69 6e 68 65 72 69 74 61 testing inherita
cb00: 6e 63 65 20 6f 66 20 61 63 63 65 70 74 65 64 20 nce of accepted
cb10: 73 6f 63 6b 65 74 73 7d 20 5c 0a 09 7b 73 6f 63 sockets} \..{soc
cb20: 6b 65 74 20 65 78 65 63 20 75 6e 69 78 4f 6e 6c ket exec unixOnl
cb30: 79 7d 20 7b 0a 20 20 20 20 6d 61 6b 65 46 69 6c y} {. makeFil
cb40: 65 20 7b 7d 20 73 63 72 69 70 74 31 0a 20 20 20 e {} script1.
cb50: 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 makeFile {} scr
cb60: 69 70 74 32 0a 0a 20 20 20 20 73 65 74 20 66 20 ipt2.. set f
cb70: 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 77 5d [open script1 w]
cb80: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
cb90: 61 66 74 65 72 20 31 30 30 30 30 20 65 78 69 74 after 10000 exit
cba0: 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a ..vwait forever.
cbb0: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
cbc0: 24 66 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f.. set f [o
cbd0: 70 65 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 pen script2 w].
cbe0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
cbf0: 20 73 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 set tclsh $::tc
cc00: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a ltest::tcltest].
cc10: 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 puts $f [lis
cc20: 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 t set auto_path
cc30: 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 $auto_path].
cc40: 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 puts $f {..packa
cc50: 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 ge require tls.
cc60: 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 }. puts $f
cc70: 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 "set f \[tls::s
cc80: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
cc90: 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cept \.. -cer
cca0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
ccb0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
ccc0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
ccd0: 65 72 4b 65 79 20 38 39 33 30 5c 5d 22 0a 20 20 erKey 8930\]".
cce0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
ccf0: 63 20 61 63 63 65 70 74 20 7b 20 66 69 6c 65 20 c accept { file
cd00: 68 6f 73 74 20 70 6f 72 74 20 7d 20 7b 0a 09 20 host port } {..
cd10: 20 20 20 67 6c 6f 62 61 6c 20 74 63 6c 73 68 0a global tclsh.
cd20: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
cd30: 24 66 69 6c 65 20 2d 62 75 66 66 65 72 69 6e 67 $file -buffering
cd40: 20 6c 69 6e 65 0a 09 20 20 20 20 70 75 74 73 20 line.. puts
cd50: 24 66 69 6c 65 20 7b 74 65 73 74 20 64 61 74 61 $file {test data
cd60: 20 6f 6e 20 73 6f 63 6b 65 74 7d 0a 09 20 20 20 on socket}..
cd70: 20 65 78 65 63 20 24 74 63 6c 73 68 20 73 63 72 exec $tclsh scr
cd80: 69 70 74 31 20 26 0a 09 20 20 20 20 61 66 74 65 ipt1 &.. afte
cd90: 72 20 31 30 30 30 20 65 78 69 74 0a 09 7d 0a 09 r 1000 exit..}..
cda0: 76 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 vwait forever.
cdb0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
cdc0: 0a 0a 20 20 20 20 23 20 4c 61 75 6e 63 68 20 74 .. # Launch t
cdd0: 68 65 20 73 63 72 69 70 74 32 20 70 72 6f 63 65 he script2 proce
cde0: 73 73 20 61 6e 64 20 63 6f 6e 6e 65 63 74 20 74 ss and connect t
cdf0: 6f 20 69 74 2e 20 20 53 65 65 20 68 6f 77 20 6c o it. See how l
ce00: 6f 6e 67 0a 20 20 20 20 23 20 74 68 65 20 73 6f ong. # the so
ce10: 63 6b 65 74 20 73 74 61 79 73 20 6f 70 65 6e 0a cket stays open.
ce20: 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c . exec $::tcl
ce30: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
ce40: 72 69 70 74 32 20 26 0a 0a 20 20 20 20 61 66 74 ript2 &.. aft
ce50: 65 72 20 32 30 30 30 20 73 65 74 20 6f 6b 5f 74 er 2000 set ok_t
ce60: 6f 5f 70 72 6f 63 65 65 64 20 31 0a 20 20 20 20 o_proceed 1.
ce70: 76 77 61 69 74 20 6f 6b 5f 74 6f 5f 70 72 6f 63 vwait ok_to_proc
ce80: 65 65 64 0a 0a 20 20 20 20 73 65 74 20 66 20 5b eed.. set f [
ce90: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
cea0: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
ceb0: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
cec0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
ced0: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
cee0: 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 38 39 127.0.0.1 89
cef0: 33 30 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 30]. fconfigu
cf00: 72 65 20 24 66 20 2d 62 75 66 66 65 72 69 6e 67 re $f -buffering
cf10: 20 66 75 6c 6c 20 2d 62 6c 6f 63 6b 69 6e 67 20 full -blocking
cf20: 30 0a 20 20 20 20 23 20 57 65 20 6e 65 65 64 20 0. # We need
cf30: 74 6f 20 70 75 74 20 61 20 62 79 74 65 20 69 6e to put a byte in
cf40: 74 6f 20 74 68 65 20 72 65 61 64 20 71 75 65 75 to the read queu
cf50: 65 2c 20 6f 74 68 65 72 77 69 73 65 20 74 68 65 e, otherwise the
cf60: 0a 20 20 20 20 23 20 54 4c 53 20 68 61 6e 64 73 . # TLS hands
cf70: 68 61 6b 65 20 64 6f 65 73 6e 27 74 20 66 69 6e hake doesn't fin
cf80: 69 73 68 0a 20 20 20 20 70 75 74 73 20 24 66 20 ish. puts $f
cf90: 61 3b 20 66 6c 75 73 68 20 24 66 0a 20 20 20 20 a; flush $f.
cfa0: 66 69 6c 65 65 76 65 6e 74 20 24 66 20 72 65 61 fileevent $f rea
cfb0: 64 61 62 6c 65 20 5b 6c 69 73 74 20 67 65 74 64 dable [list getd
cfc0: 61 74 61 20 61 63 63 65 70 74 65 64 20 24 66 5d ata accepted $f]
cfd0: 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 73 .. # If the s
cfe0: 6f 63 6b 65 74 20 69 73 20 73 74 69 6c 6c 20 6f ocket is still o
cff0: 70 65 6e 20 61 66 74 65 72 20 35 20 73 65 63 6f pen after 5 seco
d000: 6e 64 73 2c 20 74 68 65 20 73 63 72 69 70 74 31 nds, the script1
d010: 20 70 72 6f 63 65 73 73 0a 20 20 20 20 23 20 6d process. # m
d020: 75 73 74 20 68 61 76 65 20 69 6e 68 65 72 69 74 ust have inherit
d030: 65 64 20 74 68 65 20 61 63 63 65 70 74 65 64 20 ed the accepted
d040: 73 6f 63 6b 65 74 2e 0a 0a 20 20 20 20 73 65 74 socket... set
d050: 20 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 failed 0. af
d060: 74 65 72 20 35 30 30 30 20 73 65 74 20 66 61 69 ter 5000 set fai
d070: 6c 65 64 20 31 0a 0a 20 20 20 20 76 77 61 69 74 led 1.. vwait
d080: 20 78 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b x. set x.} {
d090: 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 20 accepted socket
d0a0: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
d0b0: 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 d}..test tlsIO-1
d0c0: 33 2e 31 20 7b 54 65 73 74 69 6e 67 20 75 73 65 3.1 {Testing use
d0d0: 20 6f 66 20 73 68 61 72 65 64 20 73 6f 63 6b 65 of shared socke
d0e0: 74 20 62 65 74 77 65 65 6e 20 74 77 6f 20 74 68 t between two th
d0f0: 72 65 61 64 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 reads} \..{socke
d100: 74 20 74 65 73 74 74 68 72 65 61 64 7d 20 7b 0a t testthread} {.
d110: 20 20 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 # HOBBS: nev
d120: 65 72 20 74 65 73 74 65 64 0a 20 20 20 20 72 65 er tested. re
d130: 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a moveFile script.
d140: 20 20 20 20 74 68 72 65 61 64 52 65 61 70 0a 0a threadReap..
d150: 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 0a 20 makeFile {.
d160: 20 20 20 09 70 61 63 6b 61 67 65 20 72 65 71 75 .package requ
d170: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 66 20 5b ire tls..set f [
d180: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
d190: 76 65 72 20 61 63 63 65 70 74 20 38 38 32 38 5d ver accept 8828]
d1a0: 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 ..proc accept {s
d1b0: 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 20 20 20 a p} {.
d1c0: 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 73 fileevent $s
d1d0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
d1e0: 65 63 68 6f 20 24 73 5d 0a 20 20 20 20 20 20 20 echo $s].
d1f0: 20 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 fconfigure
d200: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
d210: 6e 65 0a 20 20 20 20 20 20 20 20 7d 0a 09 70 72 ne. }..pr
d220: 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 oc echo {s} {..
d230: 20 20 20 20 67 6c 6f 62 61 6c 20 69 0a 20 20 20 global i.
d240: 20 20 20 20 20 20 20 20 20 20 73 65 74 20 6c 20 set l
d250: 5b 67 65 74 73 20 24 73 5d 0a 20 20 20 20 20 20 [gets $s].
d260: 20 20 20 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 if {[eof
d270: 24 73 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 $s]} {.
d280: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
d290: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d2a0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 close $s.
d2b0: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
d2c0: 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 x done.
d2d0: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 20 20 } else {..
d2e0: 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a 20 20 incr i.
d2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 70 p
d300: 75 74 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 uts $s $l.
d310: 20 20 20 20 20 20 20 7d 0a 09 7d 0a 09 73 65 74 }..}..set
d320: 20 69 20 30 0a 09 76 77 61 69 74 20 78 0a 09 63 i 0..vwait x..c
d330: 6c 6f 73 65 20 24 66 0a 0a 09 23 20 74 68 72 65 lose $f...# thre
d340: 61 64 20 63 6c 65 61 6e 73 20 69 74 73 65 6c 66 ad cleans itself
d350: 20 75 70 2e 0a 09 74 65 73 74 74 68 72 65 61 64 up...testthread
d360: 20 65 78 69 74 0a 20 20 20 20 7d 20 73 63 72 69 exit. } scri
d370: 70 74 0a 0a 20 20 20 20 23 20 63 72 65 61 74 65 pt.. # create
d380: 20 61 20 74 68 72 65 61 64 0a 20 20 20 20 73 65 a thread. se
d390: 74 20 73 65 72 76 65 72 74 68 72 65 61 64 20 5b t serverthread [
d3a0: 74 65 73 74 74 68 72 65 61 64 20 63 72 65 61 74 testthread creat
d3b0: 65 20 7b 20 73 6f 75 72 63 65 20 73 63 72 69 70 e { source scrip
d3c0: 74 20 7d 20 5d 0a 20 20 20 20 75 70 64 61 74 65 t } ]. update
d3d0: 0a 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 .. after 1000
d3e0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
d3f0: 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e :socket 127.0.0.
d400: 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 6f 6e 1 8828]. fcon
d410: 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 65 figure $s -buffe
d420: 72 69 6e 67 20 6c 69 6e 65 0a 0a 20 20 20 20 63 ring line.. c
d430: 61 74 63 68 20 7b 0a 09 70 75 74 73 20 24 73 20 atch {..puts $s
d440: 22 68 65 6c 6c 6f 22 0a 09 67 65 74 73 20 24 73 "hello"..gets $s
d450: 20 72 65 73 75 6c 74 0a 20 20 20 20 7d 0a 20 20 result. }.
d460: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 75 close $s. u
d470: 70 64 61 74 65 0a 0a 20 20 20 20 61 66 74 65 72 pdate.. after
d480: 20 32 30 30 30 0a 20 20 20 20 6c 61 70 70 65 6e 2000. lappen
d490: 64 20 72 65 73 75 6c 74 20 5b 74 68 72 65 61 64 d result [thread
d4a0: 52 65 61 70 5d 0a 0a 20 20 20 20 73 65 74 20 72 Reap].. set r
d4b0: 65 73 75 6c 74 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 esult..} {hello
d4c0: 31 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 1}..test tlsIO-1
d4d0: 34 2e 31 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 4.1 {test tls::u
d4e0: 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 nimport} {socket
d4f0: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
d500: 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f tch {tls::unimpo
d510: 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 rt} msg] $msg.}
d520: 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 {1 {wrong # args
d530: 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 : should be "tls
d540: 3a 3a 75 6e 69 6d 70 6f 72 74 20 63 68 61 6e 6e ::unimport chann
d550: 65 6c 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f el"}}.test tlsIO
d560: 2d 31 34 2e 32 20 7b 74 65 73 74 20 74 6c 73 3a -14.2 {test tls:
d570: 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b :unimport} {sock
d580: 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b et} {. list [
d590: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d catch {tls::unim
d5a0: 70 6f 72 74 20 66 6f 6f 20 62 61 72 7d 20 6d 73 port foo bar} ms
d5b0: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
d5c0: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
d5d0: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 75 6e 69 6d ld be "tls::unim
d5e0: 70 6f 72 74 20 63 68 61 6e 6e 65 6c 22 7d 7d 0a port channel"}}.
d5f0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 33 20 test tlsIO-14.3
d600: 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 {test tls::unimp
d610: 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a ort} {socket} {.
d620: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
d630: 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 62 {tls::unimport b
d640: 6f 67 75 73 7d 20 6d 73 67 5d 20 24 6d 73 67 0a ogus} msg] $msg.
d650: 7d 20 7b 31 20 7b 63 61 6e 20 6e 6f 74 20 66 69 } {1 {can not fi
d660: 6e 64 20 63 68 61 6e 6e 65 6c 20 6e 61 6d 65 64 nd channel named
d670: 20 22 62 6f 67 75 73 22 7d 7d 0a 74 65 73 74 20 "bogus"}}.test
d680: 74 6c 73 49 4f 2d 31 34 2e 34 20 7b 74 65 73 74 tlsIO-14.4 {test
d690: 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 tls::unimport}
d6a0: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 {socket} {. #
d6b0: 20 73 74 64 69 6e 20 63 61 6e 20 74 61 6b 65 20 stdin can take
d6c0: 64 69 66 66 65 72 65 6e 74 20 6e 61 6d 65 73 20 different names
d6d0: 61 73 20 74 68 65 20 22 74 6f 70 22 20 63 68 61 as the "top" cha
d6e0: 6e 6e 65 6c 0a 20 20 20 20 6c 69 73 74 20 5b 63 nnel. list [c
d6f0: 61 74 63 68 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 atch {tls::unimp
d700: 6f 72 74 20 73 74 64 69 6e 7d 20 6d 73 67 5d 20 ort stdin} msg]
d710: 5c 0a 09 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 \..[string match
d720: 20 7b 62 61 64 20 63 68 61 6e 6e 65 6c 20 22 2a {bad channel "*
d730: 22 3a 20 6e 6f 74 20 61 20 73 74 61 63 6b 65 64 ": not a stacked
d740: 20 63 68 61 6e 6e 65 6c 7d 20 24 6d 73 67 5d 0a channel} $msg].
d750: 7d 20 7b 31 20 31 7d 0a 74 65 73 74 20 74 6c 73 } {1 1}.test tls
d760: 49 4f 2d 31 34 2e 35 20 7b 74 65 73 74 20 74 6c IO-14.5 {test tl
d770: 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f s::unimport} {so
d780: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 cket} {. set
d790: 6c 65 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 len 0. set sp
d7a0: 75 72 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 urious 0. set
d7b0: 20 64 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 done 0. proc
d7c0: 20 72 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 readlittle {s}
d7d0: 7b 0a 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f {..global spurio
d7e0: 75 73 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 us done len..set
d7f0: 20 6c 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 l [read $s 1]..
d800: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 if {[string leng
d810: 74 68 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 th $l] == 0} {..
d820: 20 20 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 if {![eof $s
d830: 5d 7d 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 ]} {...incr spur
d840: 69 6f 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 ious.. } else
d850: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 {...close $s...
d860: 73 65 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 set done 1..
d870: 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 }..} else {..
d880: 20 69 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e incr len [strin
d890: 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a g length $l]..}.
d8a0: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 }. proc a
d8b0: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
d8c0: 09 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d .fconfigure $s -
d8d0: 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 blocking 0..file
d8e0: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
d8f0: 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 e [list do_hands
d900: 68 61 6b 65 20 24 73 20 72 65 61 64 61 62 6c 65 hake $s readable
d910: 20 72 65 61 64 6c 69 74 74 6c 65 20 5c 0a 09 09 readlittle \...
d920: 2d 62 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 5d -buffering none]
d930: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
d940: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
d950: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
d960: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
d970: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
d980: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
d990: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
d9a0: 33 31 5d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 31]. set c [t
d9b0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 ls::socket -cert
d9c0: 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 file $clientCert
d9d0: 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 -cafile $caCert
d9e0: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
d9f0: 74 4b 65 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 tKey \.. loca
da00: 6c 68 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 20 lhost 8831].
da10: 23 20 6f 6e 6c 79 20 74 68 65 20 63 6c 69 65 6e # only the clien
da20: 74 20 67 65 74 73 20 74 6c 73 3a 3a 69 6d 70 6f t gets tls::impo
da30: 72 74 0a 20 20 20 20 73 65 74 20 72 65 73 20 5b rt. set res [
da40: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 24 63 tls::unimport $c
da50: 5d 0a 20 20 20 20 6c 69 73 74 20 24 72 65 73 20 ]. list $res
da60: 5b 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 63 [catch {close $c
da70: 7d 20 65 72 72 5d 20 24 65 72 72 20 5c 0a 09 5b } err] $err \..[
da80: 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 73 7d catch {close $s}
da90: 20 65 72 72 5d 20 24 65 72 72 0a 7d 20 7b 7b 7d err] $err.} {{}
daa0: 20 30 20 7b 7d 20 30 20 7b 7d 7d 0a 0a 74 65 73 0 {} 0 {}}..tes
dab0: 74 20 74 6c 73 2d 62 75 67 35 38 2d 31 2e 30 20 t tls-bug58-1.0
dac0: 7b 74 65 73 74 20 70 72 6f 74 6f 63 6f 6c 20 6e {test protocol n
dad0: 65 67 6f 74 69 61 74 69 6f 6e 20 66 61 69 6c 75 egotiation failu
dae0: 72 65 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 re} {socket} {.
daf0: 20 20 20 23 20 46 6f 6c 6c 6f 77 69 6e 67 20 63 # Following c
db00: 6f 64 65 20 69 73 20 62 61 73 65 64 20 6f 6e 20 ode is based on
db10: 77 68 61 74 20 77 61 73 20 72 65 70 6f 72 74 65 what was reporte
db20: 64 20 69 6e 20 62 75 67 20 23 35 38 2e 20 50 72 d in bug #58. Pr
db30: 69 6f 72 0a 20 20 20 20 23 20 74 6f 20 66 69 78 ior. # to fix
db40: 20 74 68 65 20 70 72 6f 67 72 61 6d 20 77 6f 75 the program wou
db50: 6c 64 20 63 72 61 73 68 20 77 69 74 68 20 61 20 ld crash with a
db60: 73 65 67 66 61 75 6c 74 2e 0a 20 20 20 20 70 72 segfault.. pr
db70: 6f 63 20 41 63 63 65 70 74 20 7b 73 6f 63 6b 20 oc Accept {sock
db80: 61 72 67 73 7d 20 7b 0a 20 20 20 20 20 20 20 20 args} {.
db90: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 6b fconfigure $sock
dba0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 3b 0a 20 20 -blocking 0;.
dbb0: 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 fileevent
dbc0: 24 73 6f 63 6b 20 72 65 61 64 61 62 6c 65 20 5b $sock readable [
dbd0: 6c 69 73 74 20 48 61 6e 64 73 68 61 6b 65 20 24 list Handshake $
dbe0: 73 6f 63 6b 5d 0a 20 20 20 20 7d 0a 20 20 20 20 sock]. }.
dbf0: 70 72 6f 63 20 48 61 6e 64 73 68 61 6b 65 20 7b proc Handshake {
dc00: 73 6f 63 6b 7d 20 7b 0a 20 20 20 20 20 20 20 20 sock} {.
dc10: 73 65 74 20 3a 3a 64 6f 6e 65 20 48 41 4e 44 0a set ::done HAND.
dc20: 20 20 20 20 20 20 20 20 63 61 74 63 68 20 7b 74 catch {t
dc30: 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 ls::handshake $s
dc40: 6f 63 6b 7d 20 6d 73 67 0a 20 20 20 20 20 20 20 ock} msg.
dc50: 20 73 65 74 20 3a 3a 64 6f 6e 65 20 24 6d 73 67 set ::done $msg
dc60: 0a 20 20 20 20 7d 0a 20 20 20 20 23 20 4e 4f 54 . }. # NOT
dc70: 45 3a 20 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e E: when doing an
dc80: 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 in-process clie
dc90: 6e 74 2f 73 65 72 76 65 72 20 74 65 73 74 2c 20 nt/server test,
dca0: 62 6f 74 68 20 73 69 64 65 73 20 6e 65 65 64 0a both sides need.
dcb0: 20 20 20 20 23 20 74 6f 20 62 65 20 6e 6f 6e 2d # to be non-
dcc0: 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 68 65 blocking for the
dcd0: 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 0a 0a TLS handshake..
dce0: 20 20 20 20 23 20 53 65 72 76 65 72 20 2d 20 4f # Server - O
dcf0: 6e 6c 79 20 61 63 63 65 70 74 20 54 4c 53 20 31 nly accept TLS 1
dd00: 2e 33 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c .3. set s [tl
dd10: 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 20 20 20 20 s::socket \.
dd20: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
dd30: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
dd40: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
dd50: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 2d 72 le $serverKey -r
dd60: 65 71 75 65 73 74 20 30 20 5c 0a 09 2d 72 65 71 equest 0 \..-req
dd70: 75 69 72 65 20 30 20 2d 73 73 6c 32 20 30 20 2d uire 0 -ssl2 0 -
dd80: 73 73 6c 33 20 30 20 2d 74 6c 73 31 20 30 20 2d ssl3 0 -tls1 0 -
dd90: 74 6c 73 31 2e 31 20 30 20 2d 74 6c 73 31 2e 32 tls1.1 0 -tls1.2
dda0: 20 30 20 2d 74 6c 73 31 2e 33 20 31 20 5c 0a 20 0 -tls1.3 1 \.
ddb0: 20 20 20 20 20 20 20 2d 73 65 72 76 65 72 20 41 -server A
ddc0: 63 63 65 70 74 20 38 38 33 31 5d 0a 20 20 20 20 ccept 8831].
ddd0: 23 20 43 6c 69 65 6e 74 20 2d 20 4f 6e 6c 79 20 # Client - Only
dde0: 70 72 6f 70 6f 73 65 20 54 4c 53 31 2e 32 0a 20 propose TLS1.2.
ddf0: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
de00: 6f 63 6b 65 74 20 2d 61 73 79 6e 63 20 2d 63 61 ocket -async -ca
de10: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 72 65 file $caCert -re
de20: 71 75 65 73 74 20 30 20 2d 72 65 71 75 69 72 65 quest 0 -require
de30: 20 30 20 5c 0a 09 2d 73 73 6c 32 20 30 20 2d 73 0 \..-ssl2 0 -s
de40: 73 6c 33 20 30 20 2d 74 6c 73 31 20 30 20 2d 74 sl3 0 -tls1 0 -t
de50: 6c 73 31 2e 31 20 30 20 2d 74 6c 73 31 2e 32 20 ls1.1 0 -tls1.2
de60: 31 20 2d 74 6c 73 31 2e 33 20 30 20 6c 6f 63 61 1 -tls1.3 0 loca
de70: 6c 68 6f 73 74 20 38 38 33 31 5d 0a 20 20 20 20 lhost 8831].
de80: 66 63 6f 6e 66 69 67 75 72 65 20 24 63 20 2d 62 fconfigure $c -b
de90: 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 20 70 75 locking 0. pu
dea0: 74 73 20 24 63 20 61 20 3b 20 66 6c 75 73 68 20 ts $c a ; flush
deb0: 24 63 0a 20 20 20 20 61 66 74 65 72 20 35 30 30 $c. after 500
dec0: 30 20 5b 6c 69 73 74 20 73 65 74 20 3a 3a 64 6f 0 [list set ::do
ded0: 6e 65 20 74 69 6d 65 6f 75 74 5d 0a 20 20 20 20 ne timeout].
dee0: 76 77 61 69 74 20 3a 3a 64 6f 6e 65 0a 20 20 20 vwait ::done.
def0: 20 73 77 69 74 63 68 20 2d 65 78 61 63 74 20 2d switch -exact -
df00: 2d 20 24 3a 3a 64 6f 6e 65 20 7b 0a 20 20 20 20 - $::done {.
df10: 20 20 20 20 22 68 61 6e 64 73 68 61 6b 65 20 66 "handshake f
df20: 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20 73 73 6c ailed: wrong ssl
df30: 20 76 65 72 73 69 6f 6e 22 20 2d 0a 20 20 20 20 version" -.
df40: 20 20 20 20 22 68 61 6e 64 73 68 61 6b 65 20 66 "handshake f
df50: 61 69 6c 65 64 3a 20 75 6e 73 75 70 70 6f 72 74 ailed: unsupport
df60: 65 64 20 70 72 6f 74 6f 63 6f 6c 22 20 7b 0a 20 ed protocol" {.
df70: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 3a set :
df80: 3a 64 6f 6e 65 20 22 68 61 6e 64 73 68 61 6b 65 :done "handshake
df90: 20 66 61 69 6c 65 64 3a 20 77 72 6f 6e 67 20 76 failed: wrong v
dfa0: 65 72 73 69 6f 6e 20 6e 75 6d 62 65 72 22 0a 20 ersion number".
dfb0: 20 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 20 }. }.
dfc0: 20 20 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 catch {close
dfd0: 24 63 7d 0a 20 20 20 20 63 61 74 63 68 20 7b 63 $c}. catch {c
dfe0: 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 73 65 74 lose $s}. set
dff0: 20 3a 3a 64 6f 6e 65 0a 7d 20 7b 68 61 6e 64 73 ::done.} {hands
e000: 68 61 6b 65 20 66 61 69 6c 65 64 3a 20 77 72 6f hake failed: wro
e010: 6e 67 20 76 65 72 73 69 6f 6e 20 6e 75 6d 62 65 ng version numbe
e020: 72 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 66 r}..# cleanup.if
e030: 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 20 {[string match
e040: 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 6f sock* $commandSo
e050: 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 20 cket] == 1} {.
e060: 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f puts $commandSo
e070: 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 6c 75 cket exit. flu
e080: 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 sh $commandSocke
e090: 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 t.}.catch {close
e0a0: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d $commandSocket}
e0b0: 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 72 .catch {close $r
e0c0: 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a 3a emoteProcChan}.:
e0d0: 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e 75 :tcltest::cleanu
e0e0: 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 74 64 pTests.flush std
e0f0: 6f 75 74 0a 72 65 74 75 72 6e 0a out.return.