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 23 20 52 43 53 3a 20 40 28 23 29 S..#.# RCS: @(#)
0210: 20 24 49 64 3a 20 74 6c 73 49 4f 2e 74 65 73 74 $Id: tlsIO.test
0220: 2c 76 20 31 2e 32 34 20 32 30 31 35 2f 30 36 2f ,v 1.24 2015/06/
0230: 30 36 20 30 39 3a 30 37 3a 30 38 20 61 70 6e 61 06 09:07:08 apna
0240: 64 6b 61 72 6e 69 20 45 78 70 20 24 0a 0a 23 20 dkarni Exp $..#
0250: 52 75 6e 6e 69 6e 67 20 73 6f 63 6b 65 74 20 74 Running socket t
0260: 65 73 74 73 20 77 69 74 68 20 61 20 72 65 6d 6f ests with a remo
0270: 74 65 20 73 65 72 76 65 72 3a 0a 23 20 2d 2d 2d te server:.# ---
0280: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
0290: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
02a0: 2d 2d 2d 2d 2d 2d 2d 0a 23 0a 23 20 53 6f 6d 65 -------.#.# Some
02b0: 20 74 65 73 74 73 20 69 6e 20 73 6f 63 6b 65 74 tests in socket
02c0: 2e 74 65 73 74 20 64 65 70 65 6e 64 20 6f 6e 20 .test depend on
02d0: 74 68 65 20 65 78 69 73 74 65 6e 63 65 20 6f 66 the existence of
02e0: 20 61 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 a remote server
02f0: 20 74 6f 0a 23 20 77 68 69 63 68 20 74 68 65 79 to.# which they
0300: 20 63 6f 6e 6e 65 63 74 2e 20 54 68 65 20 72 65 connect. The re
0310: 6d 6f 74 65 20 73 65 72 76 65 72 20 6d 75 73 74 mote server must
0320: 20 62 65 20 61 6e 20 69 6e 73 74 61 6e 63 65 20 be an instance
0330: 6f 66 20 74 63 6c 74 65 73 74 20 61 6e 64 20 69 of tcltest and i
0340: 74 0a 23 20 6d 75 73 74 20 72 75 6e 20 74 68 65 t.# must run the
0350: 20 73 63 72 69 70 74 20 66 6f 75 6e 64 20 69 6e script found in
0360: 20 74 68 65 20 66 69 6c 65 20 22 72 65 6d 6f 74 the file "remot
0370: 65 2e 74 63 6c 22 20 69 6e 20 74 68 69 73 20 64 e.tcl" in this d
0380: 69 72 65 63 74 6f 72 79 2e 20 59 6f 75 0a 23 20 irectory. You.#
0390: 63 61 6e 20 73 74 61 72 74 20 74 68 65 20 72 65 can start the re
03a0: 6d 6f 74 65 20 73 65 72 76 65 72 20 6f 6e 20 61 mote server on a
03b0: 6e 79 20 6d 61 63 68 69 6e 65 20 72 65 61 63 68 ny machine reach
03c0: 61 62 6c 65 20 66 72 6f 6d 20 74 68 65 20 6d 61 able from the ma
03d0: 63 68 69 6e 65 20 6f 6e 0a 23 20 77 68 69 63 68 chine on.# which
03e0: 20 79 6f 75 20 77 61 6e 74 20 74 6f 20 72 75 6e you want to run
03f0: 20 74 68 65 20 73 6f 63 6b 65 74 20 74 65 73 74 the socket test
0400: 73 2c 20 62 79 20 69 73 73 75 69 6e 67 3a 0a 23 s, by issuing:.#
0410: 0a 23 20 20 20 20 20 74 63 6c 74 65 73 74 20 72 .# tcltest r
0420: 65 6d 6f 74 65 2e 74 63 6c 20 2d 70 6f 72 74 20 emote.tcl -port
0430: 38 30 34 38 09 23 20 4f 72 20 63 68 6f 6f 73 65 8048.# Or choose
0440: 20 61 6e 6f 74 68 65 72 20 70 6f 72 74 20 6e 75 another port nu
0450: 6d 62 65 72 2e 0a 23 0a 23 20 49 66 20 74 68 65 mber..#.# If the
0460: 20 6d 61 63 68 69 6e 65 20 79 6f 75 20 61 72 65 machine you are
0470: 20 72 75 6e 6e 69 6e 67 20 74 68 65 20 72 65 6d running the rem
0480: 6f 74 65 20 73 65 72 76 65 72 20 6f 6e 20 68 61 ote server on ha
0490: 73 20 73 65 76 65 72 61 6c 20 49 50 0a 23 20 69 s several IP.# i
04a0: 6e 74 65 72 66 61 63 65 73 2c 20 79 6f 75 20 63 nterfaces, you c
04b0: 61 6e 20 63 68 6f 6f 73 65 20 77 68 69 63 68 20 an choose which
04c0: 69 6e 74 65 72 66 61 63 65 20 74 68 65 20 73 65 interface the se
04d0: 72 76 65 72 20 6c 69 73 74 65 6e 73 20 6f 6e 20 rver listens on
04e0: 66 6f 72 0a 23 20 63 6f 6e 6e 65 63 74 69 6f 6e for.# connection
04f0: 73 20 62 79 20 73 70 65 63 69 66 79 69 6e 67 20 s by specifying
0500: 74 68 65 20 2d 61 64 64 72 65 73 73 20 63 6f 6d the -address com
0510: 6d 61 6e 64 20 6c 69 6e 65 20 66 6c 61 67 2c 20 mand line flag,
0520: 73 6f 3a 0a 23 0a 23 20 20 20 20 20 74 63 6c 74 so:.#.# tclt
0530: 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c 20 2d est remote.tcl -
0540: 61 64 64 72 65 73 73 20 79 6f 75 72 2e 6d 61 63 address your.mac
0550: 68 69 6e 65 2e 63 6f 6d 0a 23 0a 23 20 54 68 65 hine.com.#.# The
0560: 73 65 20 6f 70 74 69 6f 6e 73 20 63 61 6e 20 61 se options can a
0570: 6c 73 6f 20 62 65 20 73 65 74 20 62 79 20 65 6e lso be set by en
0580: 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 62 vironment variab
0590: 6c 65 73 2e 20 4f 6e 20 55 6e 69 78 2c 20 79 6f les. On Unix, yo
05a0: 75 20 63 61 6e 0a 23 20 74 79 70 65 20 74 68 65 u can.# type the
05b0: 73 65 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 74 se commands to t
05c0: 68 65 20 73 68 65 6c 6c 20 66 72 6f 6d 20 77 68 he shell from wh
05d0: 69 63 68 20 74 68 65 20 72 65 6d 6f 74 65 20 73 ich the remote s
05e0: 65 72 76 65 72 20 69 73 20 73 74 61 72 74 65 64 erver is started
05f0: 3a 0a 23 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 :.#.# shell%
0600: 20 73 65 74 65 6e 76 20 73 65 72 76 65 72 50 6f setenv serverPo
0610: 72 74 20 38 30 34 38 0a 23 20 20 20 20 20 73 68 rt 8048.# sh
0620: 65 6c 6c 25 20 73 65 74 65 6e 76 20 73 65 72 76 ell% setenv serv
0630: 65 72 41 64 64 72 65 73 73 20 79 6f 75 72 2e 6d erAddress your.m
0640: 61 63 68 69 6e 65 2e 63 6f 6d 0a 23 0a 23 20 61 achine.com.#.# a
0650: 6e 64 20 73 75 62 73 65 71 75 65 6e 74 6c 79 20 nd subsequently
0660: 79 6f 75 20 63 61 6e 20 73 74 61 72 74 20 74 68 you can start th
0670: 65 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 e remote server
0680: 77 69 74 68 3a 0a 23 0a 23 20 20 20 20 20 74 63 with:.#.# tc
0690: 6c 74 65 73 74 20 72 65 6d 6f 74 65 2e 74 63 6c ltest remote.tcl
06a0: 0a 23 0a 23 20 74 6f 20 68 61 76 65 20 69 74 20 .#.# to have it
06b0: 6c 69 73 74 65 6e 20 6f 6e 20 70 6f 72 74 20 38 listen on port 8
06c0: 30 34 38 20 6f 6e 20 74 68 65 20 69 6e 74 65 72 048 on the inter
06d0: 66 61 63 65 20 79 6f 75 72 2e 6d 61 63 68 69 6e face your.machin
06e0: 65 2e 63 6f 6d 2e 0a 23 0a 23 20 57 68 65 6e 20 e.com..#.# When
06f0: 74 68 65 20 73 65 72 76 65 72 20 73 74 61 72 74 the server start
0700: 73 2c 20 69 74 20 70 72 69 6e 74 73 20 6f 75 74 s, it prints out
0710: 20 61 20 64 65 74 61 69 6c 65 64 20 6d 65 73 73 a detailed mess
0720: 61 67 65 20 63 6f 6e 74 61 69 6e 69 6e 67 20 69 age containing i
0730: 74 73 0a 23 20 63 6f 6e 66 69 67 75 72 61 74 69 ts.# configurati
0740: 6f 6e 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 2c 20 on information,
0750: 61 6e 64 20 69 74 20 77 69 6c 6c 20 62 6c 6f 63 and it will bloc
0760: 6b 20 75 6e 74 69 6c 20 6b 69 6c 6c 65 64 20 77 k until killed w
0770: 69 74 68 20 61 20 43 74 72 6c 2d 43 2e 0a 23 20 ith a Ctrl-C..#
0780: 4f 6e 63 65 20 74 68 65 20 72 65 6d 6f 74 65 20 Once the remote
0790: 73 65 72 76 65 72 20 65 78 69 73 74 73 2c 20 79 server exists, y
07a0: 6f 75 20 63 61 6e 20 72 75 6e 20 74 68 65 20 74 ou can run the t
07b0: 65 73 74 73 20 69 6e 20 73 6f 63 6b 65 74 2e 74 ests in socket.t
07c0: 65 73 74 20 77 69 74 68 0a 23 20 74 68 65 20 73 est with.# the s
07d0: 65 72 76 65 72 20 62 79 20 73 65 74 74 69 6e 67 erver by setting
07e0: 20 74 77 6f 20 54 63 6c 20 76 61 72 69 61 62 6c two Tcl variabl
07f0: 65 73 3a 0a 23 0a 23 20 20 20 20 20 25 20 73 65 es:.#.# % se
0800: 74 20 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 t remoteServerIP
0810: 20 3c 6e 61 6d 65 20 6f 72 20 61 64 64 72 65 73 <name or addres
0820: 73 20 6f 66 20 6d 61 63 68 69 6e 65 20 6f 6e 20 s of machine on
0830: 77 68 69 63 68 20 73 65 72 76 65 72 20 72 75 6e which server run
0840: 73 3e 0a 23 20 20 20 20 20 25 20 73 65 74 20 72 s>.# % set r
0850: 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 emoteServerPort
0860: 38 30 34 38 0a 23 0a 23 20 54 68 65 73 65 20 76 8048.#.# These v
0870: 61 72 69 61 62 6c 65 73 20 61 72 65 20 61 6c 73 ariables are als
0880: 6f 20 73 65 74 74 61 62 6c 65 20 66 72 6f 6d 20 o settable from
0890: 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e 74 2e the environment.
08a0: 20 4f 6e 20 55 6e 69 78 2c 20 79 6f 75 20 63 61 On Unix, you ca
08b0: 6e 3a 0a 23 0a 23 20 20 20 20 20 73 68 65 6c 6c n:.#.# shell
08c0: 25 20 73 65 74 65 6e 76 20 72 65 6d 6f 74 65 53 % setenv remoteS
08d0: 65 72 76 65 72 49 50 20 6d 61 63 68 69 6e 65 2e erverIP machine.
08e0: 77 68 65 72 65 2e 73 65 72 76 65 72 2e 72 75 6e where.server.run
08f0: 73 0a 23 20 20 20 20 20 73 68 65 6c 6c 25 20 73 s.# shell% s
0900: 65 74 65 6e 76 20 72 65 6d 6f 74 65 53 65 72 76 etenv remoteServ
0910: 65 72 50 6f 72 74 20 38 30 34 38 0a 23 0a 23 20 erPort 8048.#.#
0920: 54 68 65 20 70 72 65 61 6d 62 6c 65 20 6f 66 20 The preamble of
0930: 74 68 65 20 73 6f 63 6b 65 74 2e 74 65 73 74 20 the socket.test
0940: 66 69 6c 65 20 63 68 65 63 6b 73 20 74 6f 20 73 file checks to s
0950: 65 65 20 69 66 20 74 68 65 20 76 61 72 69 61 62 ee if the variab
0960: 6c 65 73 20 61 72 65 20 73 65 74 0a 23 20 65 69 les are set.# ei
0970: 74 68 65 72 20 69 6e 20 54 63 6c 20 6f 72 20 69 ther in Tcl or i
0980: 6e 20 74 68 65 20 65 6e 76 69 72 6f 6e 6d 65 6e n the environmen
0990: 74 3b 20 69 66 20 74 68 65 79 20 61 72 65 2c 20 t; if they are,
09a0: 69 74 20 61 74 74 65 6d 70 74 73 20 74 6f 20 63 it attempts to c
09b0: 6f 6e 6e 65 63 74 20 74 6f 0a 23 20 74 68 65 20 onnect to.# the
09c0: 73 65 72 76 65 72 2e 20 49 66 20 74 68 65 20 63 server. If the c
09d0: 6f 6e 6e 65 63 74 69 6f 6e 20 69 73 20 73 75 63 onnection is suc
09e0: 63 65 73 73 66 75 6c 2c 20 74 68 65 20 74 65 73 cessful, the tes
09f0: 74 73 20 75 73 69 6e 67 20 74 68 65 20 72 65 6d ts using the rem
0a00: 6f 74 65 0a 23 20 73 65 72 76 65 72 20 77 69 6c ote.# server wil
0a10: 6c 20 62 65 20 70 65 72 66 6f 72 6d 65 64 3b 20 l be performed;
0a20: 6f 74 68 65 72 77 69 73 65 2c 20 69 74 20 77 69 otherwise, it wi
0a30: 6c 6c 20 61 74 74 65 6d 70 74 20 74 6f 20 73 74 ll attempt to st
0a40: 61 72 74 20 74 68 65 20 72 65 6d 6f 74 65 0a 23 art the remote.#
0a50: 20 73 65 72 76 65 72 20 28 76 69 61 20 65 78 65 server (via exe
0a60: 63 29 20 6f 6e 20 70 6c 61 74 66 6f 72 6d 73 20 c) on platforms
0a70: 74 68 61 74 20 73 75 70 70 6f 72 74 20 74 68 69 that support thi
0a80: 73 2c 20 6f 6e 20 74 68 65 20 6c 6f 63 61 6c 20 s, on the local
0a90: 68 6f 73 74 2c 0a 23 20 6c 69 73 74 65 6e 69 6e host,.# listenin
0aa0: 67 20 61 74 20 70 6f 72 74 20 38 30 34 38 2e 20 g at port 8048.
0ab0: 49 66 20 61 6c 6c 20 66 61 69 6c 73 2c 20 61 20 If all fails, a
0ac0: 6d 65 73 73 61 67 65 20 69 73 20 70 72 69 6e 74 message is print
0ad0: 65 64 20 61 6e 64 20 74 68 65 20 74 65 73 74 73 ed and the tests
0ae0: 0a 23 20 75 73 69 6e 67 20 74 68 65 20 72 65 6d .# using the rem
0af0: 6f 74 65 20 73 65 72 76 65 72 20 61 72 65 20 6e ote server are n
0b00: 6f 74 20 70 65 72 66 6f 72 6d 65 64 2e 0a 0a 70 ot performed...p
0b10: 72 6f 63 20 64 70 75 74 73 20 7b 6d 73 67 7d 20 roc dputs {msg}
0b20: 7b 20 72 65 74 75 72 6e 20 3b 20 70 75 74 73 20 { return ; puts
0b30: 73 74 64 65 72 72 20 24 6d 73 67 20 3b 20 66 6c stderr $msg ; fl
0b40: 75 73 68 20 73 74 64 65 72 72 20 7d 0a 0a 69 66 ush stderr }..if
0b50: 20 7b 5b 6c 73 65 61 72 63 68 20 5b 6e 61 6d 65 {[lsearch [name
0b60: 73 70 61 63 65 20 63 68 69 6c 64 72 65 6e 5d 20 space children]
0b70: 3a 3a 74 63 6c 74 65 73 74 5d 20 3d 3d 20 2d 31 ::tcltest] == -1
0b80: 7d 20 7b 0a 20 20 20 20 70 61 63 6b 61 67 65 20 } {. package
0b90: 72 65 71 75 69 72 65 20 74 63 6c 74 65 73 74 0a require tcltest.
0ba0: 20 20 20 20 6e 61 6d 65 73 70 61 63 65 20 69 6d namespace im
0bb0: 70 6f 72 74 20 2d 66 6f 72 63 65 20 3a 3a 74 63 port -force ::tc
0bc0: 6c 74 65 73 74 3a 3a 2a 0a 7d 0a 0a 23 20 54 68 ltest::*.}..# Th
0bd0: 65 20 62 75 69 6c 64 20 64 69 72 20 69 73 20 61 e build dir is a
0be0: 64 64 65 64 20 61 73 20 74 68 65 20 66 69 72 73 dded as the firs
0bf0: 74 20 65 6c 65 6d 65 6e 74 20 6f 66 20 24 50 41 t element of $PA
0c00: 54 48 0a 23 20 4c 6f 61 64 20 74 68 65 20 74 6c TH.# Load the tl
0c10: 73 20 70 61 63 6b 61 67 65 0a 70 61 63 6b 61 67 s package.packag
0c20: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 0a 73 e require tls..s
0c30: 65 74 20 74 6c 73 53 65 72 76 65 72 50 6f 72 74 et tlsServerPort
0c40: 20 38 30 34 38 0a 0a 23 20 53 70 65 63 69 66 79 8048..# Specify
0c50: 20 77 68 65 72 65 20 74 68 65 20 63 65 72 74 69 where the certi
0c60: 66 69 63 61 74 65 73 20 61 72 65 0a 0a 73 65 74 ficates are..set
0c70: 20 63 65 72 74 73 44 69 72 09 5b 66 69 6c 65 20 certsDir.[file
0c80: 6a 6f 69 6e 20 5b 66 69 6c 65 20 64 69 72 6e 61 join [file dirna
0c90: 6d 65 20 5b 69 6e 66 6f 20 73 63 72 69 70 74 5d me [info script]
0ca0: 5d 20 63 65 72 74 73 5d 0a 73 65 74 20 73 65 72 ] certs].set ser
0cb0: 76 65 72 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f verCert.[file jo
0cc0: 69 6e 20 24 63 65 72 74 73 44 69 72 20 73 65 72 in $certsDir ser
0cd0: 76 65 72 2e 70 65 6d 5d 0a 73 65 74 20 63 6c 69 ver.pem].set cli
0ce0: 65 6e 74 43 65 72 74 09 5b 66 69 6c 65 20 6a 6f entCert.[file jo
0cf0: 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c 69 in $certsDir cli
0d00: 65 6e 74 2e 70 65 6d 5d 0a 73 65 74 20 63 61 43 ent.pem].set caC
0d10: 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 ert.[file join $
0d20: 63 65 72 74 73 44 69 72 20 63 61 2e 70 65 6d 5d certsDir ca.pem]
0d30: 0a 73 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b .set serverKey.[
0d40: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
0d50: 44 69 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a Dir server.key].
0d60: 73 65 74 20 63 6c 69 65 6e 74 4b 65 79 09 5b 66 set clientKey.[f
0d70: 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 ile join $certsD
0d80: 69 72 20 63 6c 69 65 6e 74 2e 6b 65 79 5d 0a 0a ir client.key]..
0d90: 23 20 53 6f 6d 65 20 74 65 73 74 73 20 72 65 71 # Some tests req
0da0: 75 69 72 65 20 74 68 65 20 74 65 73 74 74 68 72 uire the testthr
0db0: 65 61 64 20 61 6e 64 20 65 78 65 63 20 63 6f 6d ead and exec com
0dc0: 6d 61 6e 64 73 0a 0a 73 65 74 20 3a 3a 74 63 6c mands..set ::tcl
0dd0: 74 65 73 74 3a 3a 74 65 73 74 43 6f 6e 73 74 72 test::testConstr
0de0: 61 69 6e 74 73 28 74 65 73 74 74 68 72 65 61 64 aints(testthread
0df0: 29 20 5c 0a 09 5b 65 78 70 72 20 7b 5b 69 6e 66 ) \..[expr {[inf
0e00: 6f 20 63 6f 6d 6d 61 6e 64 73 20 74 65 73 74 74 o commands testt
0e10: 68 72 65 61 64 5d 20 21 3d 20 7b 7d 7d 5d 0a 73 hread] != {}}].s
0e20: 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 et ::tcltest::te
0e30: 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 65 78 stConstraints(ex
0e40: 65 63 29 20 5b 65 78 70 72 20 7b 5b 69 6e 66 6f ec) [expr {[info
0e50: 20 63 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d 20 commands exec]
0e60: 21 3d 20 7b 7d 7d 5d 0a 0a 23 0a 23 20 49 66 20 != {}}]..#.# If
0e70: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 6f remoteServerIP o
0e80: 72 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f r remoteServerPo
0e90: 72 74 20 61 72 65 20 6e 6f 74 20 73 65 74 2c 20 rt are not set,
0ea0: 63 68 65 63 6b 20 69 6e 20 74 68 65 0a 23 20 65 check in the.# e
0eb0: 6e 76 69 72 6f 6e 6d 65 6e 74 20 76 61 72 69 61 nvironment varia
0ec0: 62 6c 65 73 20 66 6f 72 20 65 78 74 65 72 6e 61 bles for externa
0ed0: 6c 6c 79 20 73 65 74 20 76 61 6c 75 65 73 2e 0a lly set values..
0ee0: 23 0a 0a 69 66 20 7b 21 5b 69 6e 66 6f 20 65 78 #..if {![info ex
0ef0: 69 73 74 73 20 72 65 6d 6f 74 65 53 65 72 76 65 ists remoteServe
0f00: 72 49 50 5d 7d 20 7b 0a 20 20 20 20 69 66 20 7b rIP]} {. if {
0f10: 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 65 6e 76 [info exists env
0f20: 28 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 29 (remoteServerIP)
0f30: 5d 7d 20 7b 0a 09 73 65 74 20 72 65 6d 6f 74 65 ]} {..set remote
0f40: 53 65 72 76 65 72 49 50 20 24 65 6e 76 28 72 65 ServerIP $env(re
0f50: 6d 6f 74 65 53 65 72 76 65 72 49 50 29 0a 20 20 moteServerIP).
0f60: 20 20 7d 0a 7d 0a 69 66 20 7b 21 5b 69 6e 66 6f }.}.if {![info
0f70: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 exists remoteSe
0f80: 72 76 65 72 50 6f 72 74 5d 7d 20 7b 0a 20 20 20 rverPort]} {.
0f90: 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 if {[info exist
0fa0: 73 20 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 76 s env(remoteServ
0fb0: 65 72 50 6f 72 74 29 5d 7d 20 7b 0a 09 73 65 74 erPort)]} {..set
0fc0: 20 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 remoteServerPor
0fd0: 74 20 24 65 6e 76 28 72 65 6d 6f 74 65 53 65 72 t $env(remoteSer
0fe0: 76 65 72 50 6f 72 74 29 0a 20 20 20 20 7d 20 65 verPort). } e
0ff0: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 69 66 lse {. if
1000: 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 72 {[info exists r
1010: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 5d 7d 20 emoteServerIP]}
1020: 7b 0a 09 20 20 20 20 73 65 74 20 72 65 6d 6f 74 {.. set remot
1030: 65 53 65 72 76 65 72 50 6f 72 74 20 24 74 6c 73 eServerPort $tls
1040: 53 65 72 76 65 72 50 6f 72 74 0a 20 20 20 20 20 ServerPort.
1050: 20 20 20 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 70 72 }. }.}..pr
1060: 6f 63 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 oc do_handshake
1070: 7b 73 20 7b 74 79 70 65 20 72 65 61 64 61 62 6c {s {type readabl
1080: 65 7d 20 7b 63 6d 64 20 7b 7d 7d 20 61 72 67 73 e} {cmd {}} args
1090: 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 65 6f 66 } {. if {[eof
10a0: 20 24 73 5d 7d 20 7b 0a 09 63 6c 6f 73 65 20 24 $s]} {..close $
10b0: 73 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 s..dputs "handsh
10c0: 61 6b 65 3a 20 65 6f 66 22 0a 09 73 65 74 20 3a ake: eof"..set :
10d0: 3a 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 22 65 :do_handshake "e
10e0: 6f 66 22 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 of". } elseif
10f0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 {[catch {tls::h
1100: 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 andshake $s} res
1110: 75 6c 74 5d 7d 20 7b 0a 09 23 20 53 6f 6d 65 20 ult]} {..# Some
1120: 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 errors are norma
1130: 6c 2e 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 l...dputs "hands
1140: 68 61 6b 65 3a 20 24 72 65 73 75 6c 74 22 0a 20 hake: $result".
1150: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 72 65 } elseif {$re
1160: 73 75 6c 74 20 3d 3d 20 31 7d 20 7b 0a 09 23 20 sult == 1} {..#
1170: 48 61 6e 64 73 68 61 6b 65 20 63 6f 6d 70 6c 65 Handshake comple
1180: 74 65 0a 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68 te..if {[llength
1190: 20 24 61 72 67 73 5d 7d 20 7b 20 65 76 61 6c 20 $args]} { eval
11a0: 5b 6c 69 73 74 20 66 63 6f 6e 66 69 67 75 72 65 [list fconfigure
11b0: 20 24 73 5d 20 24 61 72 67 73 20 7d 0a 09 69 66 $s] $args }..if
11c0: 20 7b 24 63 6d 64 20 3d 3d 20 22 22 7d 20 7b 0a {$cmd == ""} {.
11d0: 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 . fileevent $
11e0: 73 20 24 74 79 70 65 20 22 22 0a 09 7d 20 65 6c s $type ""..} el
11f0: 73 65 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 76 se {.. fileev
1200: 65 6e 74 20 24 73 20 24 74 79 70 65 20 22 24 63 ent $s $type "$c
1210: 6d 64 20 5b 6c 69 73 74 20 24 73 5d 22 0a 09 7d md [list $s]"..}
1220: 0a 09 64 70 75 74 73 20 22 68 61 6e 64 73 68 61 ..dputs "handsha
1230: 6b 65 3a 20 63 6f 6d 70 6c 65 74 65 22 0a 09 73 ke: complete"..s
1240: 65 74 20 3a 3a 64 6f 5f 68 61 6e 64 73 68 61 6b et ::do_handshak
1250: 65 20 22 63 6f 6d 70 6c 65 74 65 22 0a 20 20 20 e "complete".
1260: 20 7d 20 65 6c 73 65 20 7b 0a 09 64 70 75 74 73 } else {..dputs
1270: 20 22 68 61 6e 64 73 68 61 6b 65 3a 20 69 6e 20 "handshake: in
1280: 70 72 6f 67 72 65 73 73 22 0a 20 20 20 20 7d 0a progress". }.
1290: 7d 0a 0a 23 0a 23 20 43 68 65 63 6b 20 69 66 20 }..#.# Check if
12a0: 77 65 27 72 65 20 73 75 70 70 6f 73 65 64 20 74 we're supposed t
12b0: 6f 20 64 6f 20 74 65 73 74 73 20 61 67 61 69 6e o do tests again
12c0: 73 74 20 74 68 65 20 72 65 6d 6f 74 65 20 73 65 st the remote se
12d0: 72 76 65 72 0a 23 0a 0a 73 65 74 20 64 6f 54 65 rver.#..set doTe
12e0: 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 stsWithRemoteSer
12f0: 76 65 72 20 31 0a 69 66 20 7b 21 5b 69 6e 66 6f ver 1.if {![info
1300: 20 65 78 69 73 74 73 20 72 65 6d 6f 74 65 53 65 exists remoteSe
1310: 72 76 65 72 49 50 5d 20 26 26 20 28 24 74 63 6c rverIP] && ($tcl
1320: 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f _platform(platfo
1330: 72 6d 29 20 21 3d 20 22 6d 61 63 69 6e 74 6f 73 rm) != "macintos
1340: 68 22 29 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 h")} {. set r
1350: 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 31 32 emoteServerIP 12
1360: 37 2e 30 2e 30 2e 31 0a 7d 0a 69 66 20 7b 28 24 7.0.0.1.}.if {($
1370: 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 doTestsWithRemot
1380: 65 53 65 72 76 65 72 20 3d 3d 20 31 29 20 26 26 eServer == 1) &&
1390: 20 28 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 (![info exists
13a0: 72 65 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 remoteServerPort
13b0: 5d 29 7d 20 7b 0a 20 20 20 20 73 65 74 20 72 65 ])} {. set re
13c0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 20 24 moteServerPort $
13d0: 74 6c 73 53 65 72 76 65 72 50 6f 72 74 0a 7d 0a tlsServerPort.}.
13e0: 0a 23 20 41 74 74 65 6d 70 74 20 74 6f 20 63 6f .# Attempt to co
13f0: 6e 6e 65 63 74 20 74 6f 20 61 20 72 65 6d 6f 74 nnect to a remot
1400: 65 20 73 65 72 76 65 72 20 69 66 20 6f 6e 65 20 e server if one
1410: 69 73 20 61 6c 72 65 61 64 79 20 72 75 6e 6e 69 is already runni
1420: 6e 67 2e 20 49 66 20 69 74 0a 23 20 69 73 20 6e ng. If it.# is n
1430: 6f 74 20 72 75 6e 6e 69 6e 67 20 6f 72 20 66 6f ot running or fo
1440: 72 20 73 6f 6d 65 20 6f 74 68 65 72 20 72 65 61 r some other rea
1450: 73 6f 6e 20 74 68 65 20 63 6f 6e 6e 65 63 74 20 son the connect
1460: 66 61 69 6c 73 2c 20 61 74 74 65 6d 70 74 20 74 fails, attempt t
1470: 6f 0a 23 20 73 74 61 72 74 20 74 68 65 20 72 65 o.# start the re
1480: 6d 6f 74 65 20 73 65 72 76 65 72 20 6f 6e 20 74 mote server on t
1490: 68 65 20 6c 6f 63 61 6c 20 68 6f 73 74 20 6c 69 he local host li
14a0: 73 74 65 6e 69 6e 67 20 6f 6e 20 70 6f 72 74 20 stening on port
14b0: 38 30 34 38 2e 20 54 68 69 73 0a 23 20 69 73 20 8048. This.# is
14c0: 6f 6e 6c 79 20 64 6f 6e 65 20 6f 6e 20 70 6c 61 only done on pla
14d0: 74 66 6f 72 6d 73 20 74 68 61 74 20 73 75 70 70 tforms that supp
14e0: 6f 72 74 20 65 78 65 63 20 28 69 2e 65 2e 20 6e ort exec (i.e. n
14f0: 6f 74 20 6f 6e 20 74 68 65 20 4d 61 63 29 2e 20 ot on the Mac).
1500: 4f 6e 0a 23 20 70 6c 61 74 66 6f 72 6d 73 20 74 On.# platforms t
1510: 68 61 74 20 64 6f 20 6e 6f 74 20 73 75 70 70 6f hat do not suppo
1520: 72 74 20 65 78 65 63 2c 20 74 68 65 20 72 65 6d rt exec, the rem
1530: 6f 74 65 20 73 65 72 76 65 72 20 6d 75 73 74 20 ote server must
1540: 62 65 20 73 74 61 72 74 65 64 0a 23 20 62 79 20 be started.# by
1550: 74 68 65 20 75 73 65 72 20 62 65 66 6f 72 65 20 the user before
1560: 72 75 6e 6e 69 6e 67 20 74 68 65 20 74 65 73 74 running the test
1570: 73 2e 0a 0a 73 65 74 20 72 65 6d 6f 74 65 50 72 s...set remotePr
1580: 6f 63 43 68 61 6e 20 22 22 0a 73 65 74 20 63 6f ocChan "".set co
1590: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 22 22 0a 69 mmandSocket "".i
15a0: 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 52 f {$doTestsWithR
15b0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
15c0: 20 20 20 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 catch {close
15d0: 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 7d 0a $commandSocket}.
15e0: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
15f0: 73 65 74 20 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 set commandSocke
1600: 74 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c t [tls::socket \
1610: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
1620: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
1630: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
1640: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
1650: 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 \.. $remoteSe
1660: 72 76 65 72 49 50 20 24 72 65 6d 6f 74 65 53 65 rverIP $remoteSe
1670: 72 76 65 72 50 6f 72 74 5d 7d 5d 20 21 3d 20 30 rverPort]}] != 0
1680: 7d 20 7b 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 63 } {..if {[info c
1690: 6f 6d 6d 61 6e 64 73 20 65 78 65 63 5d 20 3d 3d ommands exec] ==
16a0: 20 22 22 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 ""} {.. set
16b0: 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 noRemoteTestReas
16c0: 6f 6e 20 22 63 61 6e 27 74 20 65 78 65 63 22 0a on "can't exec".
16d0: 09 20 20 20 20 73 65 74 20 64 6f 54 65 73 74 73 . set doTests
16e0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
16f0: 20 30 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 0..} else {..
1700: 20 20 73 65 74 20 72 65 6d 6f 74 65 53 65 72 76 set remoteServ
1710: 65 72 49 50 20 31 32 37 2e 30 2e 30 2e 31 0a 09 erIP 127.0.0.1..
1720: 20 20 20 20 73 65 74 20 72 65 6d 6f 74 65 46 69 set remoteFi
1730: 6c 65 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 70 le [file join [p
1740: 77 64 5d 20 72 65 6d 6f 74 65 2e 74 63 6c 5d 0a wd] remote.tcl].
1750: 09 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 . if {[catch
1760: 7b 73 65 74 20 72 65 6d 6f 74 65 50 72 6f 63 43 {set remoteProcC
1770: 68 61 6e 20 5c 0a 09 09 20 20 20 20 5b 6f 70 65 han \... [ope
1780: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
1790: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 24 72 test::tcltest $r
17a0: 65 6d 6f 74 65 46 69 6c 65 20 5c 0a 09 09 20 20 emoteFile \...
17b0: 20 20 2d 73 65 72 76 65 72 49 73 53 69 6c 65 6e -serverIsSilen
17c0: 74 20 2d 70 6f 72 74 20 24 72 65 6d 6f 74 65 53 t -port $remoteS
17d0: 65 72 76 65 72 50 6f 72 74 20 5c 0a 09 09 20 20 erverPort \...
17e0: 20 20 2d 61 64 64 72 65 73 73 20 24 72 65 6d 6f -address $remo
17f0: 74 65 53 65 72 76 65 72 49 50 5d 22 20 77 2b 5d teServerIP]" w+]
1800: 7d 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 } msg] == 0} {..
1810: 09 61 66 74 65 72 20 31 30 30 30 0a 09 09 69 66 .after 1000...if
1820: 20 7b 5b 63 61 74 63 68 20 7b 73 65 74 20 63 6f {[catch {set co
1830: 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 5b 74 6c 73 mmandSocket [tls
1840: 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 6c 65 ::socket -cafile
1850: 20 24 63 61 43 65 72 74 20 5c 0a 09 09 09 2d 63 $caCert \....-c
1860: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
1870: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
1880: 69 65 6e 74 4b 65 79 20 5c 0a 09 09 09 24 72 65 ientKey \....$re
1890: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 24 72 65 moteServerIP $re
18a0: 6d 6f 74 65 53 65 72 76 65 72 50 6f 72 74 5d 7d moteServerPort]}
18b0: 20 6d 73 67 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 msg] == 0} {...
18c0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
18d0: 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 2d 74 commandSocket -t
18e0: 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 ranslation crlf
18f0: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
1900: 09 09 7d 20 65 6c 73 65 20 7b 0a 09 09 20 20 20 ..} else {...
1910: 20 73 65 74 20 6e 6f 52 65 6d 6f 74 65 54 65 73 set noRemoteTes
1920: 74 52 65 61 73 6f 6e 20 24 6d 73 67 0a 09 09 20 tReason $msg...
1930: 20 20 20 73 65 74 20 64 6f 54 65 73 74 73 57 69 set doTestsWi
1940: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 30 thRemoteServer 0
1950: 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 65 ...}.. } else
1960: 20 7b 0a 09 09 73 65 74 20 6e 6f 52 65 6d 6f 74 {...set noRemot
1970: 65 54 65 73 74 52 65 61 73 6f 6e 20 22 24 6d 73 eTestReason "$ms
1980: 67 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 g $::tcltest::tc
1990: 6c 74 65 73 74 22 0a 09 09 73 65 74 20 64 6f 54 ltest"...set doT
19a0: 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 estsWithRemoteSe
19b0: 72 76 65 72 20 30 0a 09 20 20 20 20 7d 0a 09 7d rver 0.. }..}
19c0: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 66 . } else {..f
19d0: 63 6f 6e 66 69 67 75 72 65 20 24 63 6f 6d 6d 61 configure $comma
19e0: 6e 64 53 6f 63 6b 65 74 20 2d 74 72 61 6e 73 6c ndSocket -transl
19f0: 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 75 66 66 ation crlf -buff
1a00: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 7d ering line. }
1a10: 0a 7d 0a 0a 23 20 53 6f 6d 65 20 74 65 73 74 73 .}..# Some tests
1a20: 20 61 72 65 20 72 75 6e 20 6f 6e 6c 79 20 69 66 are run only if
1a30: 20 77 65 20 61 72 65 20 64 6f 69 6e 67 20 74 65 we are doing te
1a40: 73 74 69 6e 67 20 61 67 61 69 6e 73 74 20 61 20 sting against a
1a50: 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a 73 remote server..s
1a60: 65 74 20 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 65 et ::tcltest::te
1a70: 73 74 43 6f 6e 73 74 72 61 69 6e 74 73 28 64 6f stConstraints(do
1a80: 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 53 TestsWithRemoteS
1a90: 65 72 76 65 72 29 20 24 64 6f 54 65 73 74 73 57 erver) $doTestsW
1aa0: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 0a ithRemoteServer.
1ab0: 69 66 20 7b 24 64 6f 54 65 73 74 73 57 69 74 68 if {$doTestsWith
1ac0: 52 65 6d 6f 74 65 53 65 72 76 65 72 20 3d 3d 20 RemoteServer ==
1ad0: 30 7d 20 7b 0a 20 20 20 20 69 66 20 7b 5b 73 74 0} {. if {[st
1ae0: 72 69 6e 67 20 66 69 72 73 74 20 73 20 24 3a 3a ring first s $::
1af0: 74 63 6c 74 65 73 74 3a 3a 76 65 72 62 6f 73 65 tcltest::verbose
1b00: 5d 20 21 3d 20 2d 31 7d 20 7b 0a 20 20 20 20 09 ] != -1} {. .
1b10: 70 75 74 73 20 22 53 6b 69 70 70 69 6e 67 20 74 puts "Skipping t
1b20: 65 73 74 73 20 77 69 74 68 20 72 65 6d 6f 74 65 ests with remote
1b30: 20 73 65 72 76 65 72 2e 20 53 65 65 20 74 65 73 server. See tes
1b40: 74 73 2f 73 6f 63 6b 65 74 2e 74 65 73 74 20 66 ts/socket.test f
1b50: 6f 72 22 0a 09 70 75 74 73 20 22 69 6e 66 6f 72 or"..puts "infor
1b60: 6d 61 74 69 6f 6e 20 6f 6e 20 68 6f 77 20 74 6f mation on how to
1b70: 20 72 75 6e 20 72 65 6d 6f 74 65 20 73 65 72 76 run remote serv
1b80: 65 72 2e 22 0a 09 70 75 74 73 20 22 52 65 61 73 er."..puts "Reas
1b90: 6f 6e 20 66 6f 72 20 6e 6f 74 20 64 6f 69 6e 67 on for not doing
1ba0: 20 72 65 6d 6f 74 65 20 74 65 73 74 73 3a 20 24 remote tests: $
1bb0: 6e 6f 52 65 6d 6f 74 65 54 65 73 74 52 65 61 73 noRemoteTestReas
1bc0: 6f 6e 22 0a 20 20 20 20 7d 0a 7d 0a 0a 23 0a 23 on". }.}..#.#
1bd0: 20 49 66 20 77 65 20 64 6f 20 74 68 65 20 74 65 If we do the te
1be0: 73 74 73 2c 20 64 65 66 69 6e 65 20 61 20 63 6f sts, define a co
1bf0: 6d 6d 61 6e 64 20 74 6f 20 73 65 6e 64 20 61 20 mmand to send a
1c00: 63 6f 6d 6d 61 6e 64 20 74 6f 20 74 68 65 0a 23 command to the.#
1c10: 20 72 65 6d 6f 74 65 20 73 65 72 76 65 72 2e 0a remote server..
1c20: 23 0a 0a 69 66 20 7b 24 64 6f 54 65 73 74 73 57 #..if {$doTestsW
1c30: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 20 ithRemoteServer
1c40: 3d 3d 20 31 7d 20 7b 0a 20 20 20 20 70 72 6f 63 == 1} {. proc
1c50: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 7d sendCommand {c}
1c60: 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 6d 6d 61 {..global comma
1c70: 6e 64 53 6f 63 6b 65 74 0a 0a 09 69 66 20 7b 5b ndSocket...if {[
1c80: 65 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b eof $commandSock
1c90: 65 74 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f et]} {.. erro
1ca0: 72 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 r "remote server
1cb0: 20 64 69 73 61 70 70 65 61 72 65 64 22 0a 09 7d disappeared"..}
1cc0: 0a 0a 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 ...if {[catch {p
1cd0: 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b uts $commandSock
1ce0: 65 74 20 24 63 7d 20 6d 73 67 5d 7d 20 7b 0a 09 et $c} msg]} {..
1cf0: 20 20 20 20 65 72 72 6f 72 20 22 72 65 6d 6f 74 error "remot
1d00: 65 20 73 65 72 76 65 72 20 64 69 73 61 70 70 65 e server disappe
1d10: 61 72 65 64 3a 20 24 6d 73 67 22 0a 09 7d 0a 09 ared: $msg"..}..
1d20: 69 66 20 7b 5b 63 61 74 63 68 20 7b 70 75 74 73 if {[catch {puts
1d30: 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 20 $commandSocket
1d40: 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 "--Marker--Marke
1d50: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 7d 20 6d 73 r--Marker--"} ms
1d60: 67 5d 7d 20 7b 0a 09 20 20 20 20 65 72 72 6f 72 g]} {.. error
1d70: 20 22 72 65 6d 6f 74 65 20 73 65 72 76 65 72 20 "remote server
1d80: 64 69 73 61 70 70 65 61 72 65 64 3a 20 24 6d 73 disappeared: $ms
1d90: 67 22 0a 09 7d 0a 0a 09 73 65 74 20 72 65 73 70 g"..}...set resp
1da0: 20 22 22 0a 09 77 68 69 6c 65 20 7b 31 7d 20 7b ""..while {1} {
1db0: 0a 09 20 20 20 20 73 65 74 20 6c 69 6e 65 20 5b .. set line [
1dc0: 67 65 74 73 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 gets $commandSoc
1dd0: 6b 65 74 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 ket].. if {[e
1de0: 6f 66 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 of $commandSocke
1df0: 74 5d 7d 20 7b 0a 09 09 65 72 72 6f 72 20 22 72 t]} {...error "r
1e00: 65 6d 6f 74 65 20 73 65 72 76 65 72 20 64 69 73 emote server dis
1e10: 61 70 70 65 61 72 65 64 22 0a 09 20 20 20 20 7d appeared".. }
1e20: 0a 09 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e .. if {[strin
1e30: 67 20 63 6f 6d 70 61 72 65 20 24 6c 69 6e 65 20 g compare $line
1e40: 22 2d 2d 4d 61 72 6b 65 72 2d 2d 4d 61 72 6b 65 "--Marker--Marke
1e50: 72 2d 2d 4d 61 72 6b 65 72 2d 2d 22 5d 20 3d 3d r--Marker--"] ==
1e60: 20 30 7d 20 7b 0a 09 09 69 66 20 7b 5b 73 74 72 0} {...if {[str
1e70: 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b 6c 69 6e ing compare [lin
1e80: 64 65 78 20 24 72 65 73 70 20 30 5d 20 65 72 72 dex $resp 0] err
1e90: 6f 72 5d 20 3d 3d 20 30 7d 20 7b 0a 09 09 20 20 or] == 0} {...
1ea0: 20 20 65 72 72 6f 72 20 5b 6c 69 6e 64 65 78 20 error [lindex
1eb0: 24 72 65 73 70 20 31 5d 0a 09 09 7d 20 65 6c 73 $resp 1]...} els
1ec0: 65 20 7b 0a 09 09 20 20 20 20 72 65 74 75 72 6e e {... return
1ed0: 20 5b 6c 69 6e 64 65 78 20 24 72 65 73 70 20 31 [lindex $resp 1
1ee0: 5d 0a 09 09 7d 0a 09 20 20 20 20 7d 20 65 6c 73 ]...}.. } els
1ef0: 65 20 7b 0a 09 09 61 70 70 65 6e 64 20 72 65 73 e {...append res
1f00: 70 20 24 6c 69 6e 65 20 22 5c 6e 22 0a 09 20 20 p $line "\n"..
1f10: 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 0a 20 20 }..}. }..
1f20: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 5b 6c sendCommand [l
1f30: 69 73 74 20 70 72 6f 63 20 64 70 75 74 73 20 5b ist proc dputs [
1f40: 69 6e 66 6f 20 61 72 67 73 20 64 70 75 74 73 5d info args dputs]
1f50: 20 5b 69 6e 66 6f 20 62 6f 64 79 20 64 70 75 74 [info body dput
1f60: 73 5d 5d 0a 0a 20 20 20 20 70 72 6f 63 20 73 65 s]].. proc se
1f70: 6e 64 43 65 72 74 56 61 6c 75 65 73 20 7b 7d 20 ndCertValues {}
1f80: 7b 0a 09 23 20 57 65 20 6e 65 65 64 20 74 6f 20 {..# We need to
1f90: 62 65 20 61 62 6c 65 20 74 6f 20 73 65 6e 64 20 be able to send
1fa0: 63 65 72 74 69 66 69 63 61 74 65 20 76 61 6c 75 certificate valu
1fb0: 65 73 20 74 68 61 74 20 6e 6f 72 6d 61 6c 69 7a es that normaliz
1fc0: 65 0a 09 23 20 66 69 6c 65 6e 61 6d 65 73 20 61 e..# filenames a
1fd0: 63 72 6f 73 73 20 70 6c 61 74 66 6f 72 6d 73 0a cross platforms.
1fe0: 09 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 .sendCommand {..
1ff0: 20 20 20 20 73 65 74 20 63 65 72 74 73 44 69 72 set certsDir
2000: 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 5b 66 69 6c .[file join [fil
2010: 65 20 64 69 72 6e 61 6d 65 20 5b 69 6e 66 6f 20 e dirname [info
2020: 73 63 72 69 70 74 5d 5d 20 63 65 72 74 73 5d 0a script]] certs].
2030: 09 20 20 20 20 73 65 74 20 73 65 72 76 65 72 43 . set serverC
2040: 65 72 74 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 ert.[file join $
2050: 63 65 72 74 73 44 69 72 20 73 65 72 76 65 72 2e certsDir server.
2060: 70 65 6d 5d 0a 09 20 20 20 20 73 65 74 20 63 6c pem].. set cl
2070: 69 65 6e 74 43 65 72 74 09 5b 66 69 6c 65 20 6a ientCert.[file j
2080: 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 63 6c oin $certsDir cl
2090: 69 65 6e 74 2e 70 65 6d 5d 0a 09 20 20 20 20 73 ient.pem].. s
20a0: 65 74 20 63 61 43 65 72 74 09 09 5b 66 69 6c 65 et caCert..[file
20b0: 20 6a 6f 69 6e 20 24 63 65 72 74 73 44 69 72 20 join $certsDir
20c0: 63 61 63 65 72 74 2e 70 65 6d 5d 0a 09 20 20 20 cacert.pem]..
20d0: 20 73 65 74 20 73 65 72 76 65 72 4b 65 79 09 5b set serverKey.[
20e0: 66 69 6c 65 20 6a 6f 69 6e 20 24 63 65 72 74 73 file join $certs
20f0: 44 69 72 20 73 65 72 76 65 72 2e 6b 65 79 5d 0a Dir server.key].
2100: 09 20 20 20 20 73 65 74 20 63 6c 69 65 6e 74 4b . set clientK
2110: 65 79 09 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 63 ey.[file join $c
2120: 65 72 74 73 44 69 72 20 63 6c 69 65 6e 74 2e 6b ertsDir client.k
2130: 65 79 5d 0a 09 7d 0a 20 20 20 20 7d 0a 7d 0a 0a ey]..}. }.}..
2140: 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 31 20 7b test tlsIO-1.1 {
2150: 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 arg parsing for
2160: 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 socket command}
2170: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
2180: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
2190: 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 7d :socket -server}
21a0: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
21b0: 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 {wrong # args: s
21c0: 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 hould be "tls::s
21d0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 63 6f ocket -server co
21e0: 6d 6d 61 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 mmand ?options?
21f0: 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c port"}}..test tl
2200: 73 49 4f 2d 31 2e 32 20 7b 61 72 67 20 70 61 72 sIO-1.2 {arg par
2210: 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 sing for socket
2220: 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 command} {socket
2230: 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 } {. list [ca
2240: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
2250: 20 2d 73 65 72 76 65 72 20 66 6f 6f 7d 20 6d 73 -server foo} ms
2260: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 72 g] $msg.} {1 {wr
2270: 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f 75 ong # args: shou
2280: 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f 63 6b ld be "tls::sock
2290: 65 74 20 2d 73 65 72 76 65 72 20 63 6f 6d 6d 61 et -server comma
22a0: 6e 64 20 3f 6f 70 74 69 6f 6e 73 3f 20 70 6f 72 nd ?options? por
22b0: 74 22 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f t"}}..test tlsIO
22c0: 2d 31 2e 33 20 7b 61 72 67 20 70 61 72 73 69 6e -1.3 {arg parsin
22d0: 67 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d g for socket com
22e0: 6d 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b mand} {socket} {
22f0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
2300: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d {tls::socket -m
2310: 79 61 64 64 72 7d 20 6d 73 67 5d 20 24 6d 73 67 yaddr} msg] $msg
2320: 0a 7d 20 7b 31 20 7b 22 2d 6d 79 61 64 64 72 22 .} {1 {"-myaddr"
2330: 20 6f 70 74 69 6f 6e 20 6d 75 73 74 20 62 65 20 option must be
2340: 66 6f 6c 6c 6f 77 65 64 20 62 79 20 76 61 6c 75 followed by valu
2350: 65 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d e}}..test tlsIO-
2360: 31 2e 34 20 7b 61 72 67 20 70 61 72 73 69 6e 67 1.4 {arg parsing
2370: 20 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d for socket comm
2380: 61 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a and} {socket} {.
2390: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
23a0: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 {tls::socket -my
23b0: 61 64 64 72 20 31 32 37 2e 30 2e 30 2e 31 7d 20 addr 127.0.0.1}
23c0: 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b msg] $msg.} {1 {
23d0: 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 wrong # args: sh
23e0: 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 73 6f ould be "tls::so
23f0: 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f 20 68 cket ?options? h
2400: 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 ost port"}}..tes
2410: 74 20 74 6c 73 49 4f 2d 31 2e 35 20 7b 61 72 67 t tlsIO-1.5 {arg
2420: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
2430: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
2440: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
2450: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2460: 63 6b 65 74 20 2d 6d 79 70 6f 72 74 7d 20 6d 73 cket -myport} ms
2470: 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 22 2d g] $msg.} {1 {"-
2480: 6d 79 70 6f 72 74 22 20 6f 70 74 69 6f 6e 20 6d myport" option m
2490: 75 73 74 20 62 65 20 66 6f 6c 6c 6f 77 65 64 20 ust be followed
24a0: 62 79 20 76 61 6c 75 65 7d 7d 0a 0a 74 65 73 74 by value}}..test
24b0: 20 74 6c 73 49 4f 2d 31 2e 36 20 7b 61 72 67 20 tlsIO-1.6 {arg
24c0: 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 6b parsing for sock
24d0: 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f 63 et command} {soc
24e0: 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 20 ket} {. list
24f0: 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 [catch {tls::soc
2500: 6b 65 74 20 2d 6d 79 70 6f 72 74 20 78 78 78 78 ket -myport xxxx
2510: 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 } msg] $msg.} {1
2520: 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 {wrong # args:
2530: 73 68 6f 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a should be "tls::
2540: 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f 6e 73 3f socket ?options?
2550: 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d 0a 0a 74 host port"}}..t
2560: 65 73 74 20 74 6c 73 49 4f 2d 31 2e 37 20 7b 61 est tlsIO-1.7 {a
2570: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2580: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2590: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
25a0: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
25b0: 73 6f 63 6b 65 74 20 2d 6d 79 70 6f 72 74 20 32 socket -myport 2
25c0: 35 32 32 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 522} msg] $msg.}
25d0: 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 67 {1 {wrong # arg
25e0: 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 6c s: should be "tl
25f0: 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 6f s::socket ?optio
2600: 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d 7d ns? host port"}}
2610: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e 38 ..test tlsIO-1.8
2620: 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 66 6f {arg parsing fo
2630: 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 r socket command
2640: 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 20 7b } -constraints {
2650: 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 7b 0a socket} -body {.
2660: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
2670: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 66 72 {tls::socket -fr
2680: 6f 62 6f 7a 7d 20 6d 73 67 5d 20 24 6d 73 67 0a oboz} msg] $msg.
2690: 7d 20 2d 6d 61 74 63 68 20 67 6c 6f 62 20 2d 72 } -match glob -r
26a0: 65 73 75 6c 74 20 7b 31 20 7b 62 61 64 20 6f 70 esult {1 {bad op
26b0: 74 69 6f 6e 20 22 2d 66 72 6f 62 6f 7a 22 3a 20 tion "-froboz":
26c0: 6d 75 73 74 20 62 65 20 6f 6e 65 20 6f 66 20 2a must be one of *
26d0: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 }}..test tlsIO-1
26e0: 2e 39 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 .9 {arg parsing
26f0: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
2700: 6e 64 7d 20 2d 63 6f 6e 73 74 72 61 69 6e 74 73 nd} -constraints
2710: 20 7b 73 6f 63 6b 65 74 7d 20 2d 62 6f 64 79 20 {socket} -body
2720: 7b 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 {. list [catc
2730: 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d h {tls::socket -
2740: 73 65 72 76 65 72 20 66 6f 6f 20 2d 6d 79 70 6f server foo -mypo
2750: 72 74 20 32 35 32 31 20 33 33 33 33 7d 20 6d 73 rt 2521 3333} ms
2760: 67 5d 20 24 6d 73 67 0a 7d 20 2d 6d 61 74 63 68 g] $msg.} -match
2770: 20 67 6c 6f 62 20 2d 72 65 73 75 6c 74 20 7b 31 glob -result {1
2780: 20 7b 62 61 64 20 6f 70 74 69 6f 6e 20 22 2d 6d {bad option "-m
2790: 79 70 6f 72 74 22 3a 20 6d 75 73 74 20 62 65 20 yport": must be
27a0: 6f 6e 65 20 6f 66 20 2a 7d 7d 0a 0a 74 65 73 74 one of *}}..test
27b0: 20 74 6c 73 49 4f 2d 31 2e 31 30 20 7b 61 72 67 tlsIO-1.10 {arg
27c0: 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 6f 63 parsing for soc
27d0: 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b 73 6f ket command} {so
27e0: 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 73 74 cket} {. list
27f0: 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f [catch {tls::so
2800: 63 6b 65 74 20 68 6f 73 74 20 32 35 32 38 20 2d cket host 2528 -
2810: 6a 75 6e 6b 7d 20 6d 73 67 5d 20 24 6d 73 67 0a junk} msg] $msg.
2820: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
2830: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2840: 6c 73 3a 3a 73 6f 63 6b 65 74 20 3f 6f 70 74 69 ls::socket ?opti
2850: 6f 6e 73 3f 20 68 6f 73 74 20 70 6f 72 74 22 7d ons? host port"}
2860: 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 2e }..test tlsIO-1.
2870: 31 31 20 7b 61 72 67 20 70 61 72 73 69 6e 67 20 11 {arg parsing
2880: 66 6f 72 20 73 6f 63 6b 65 74 20 63 6f 6d 6d 61 for socket comma
2890: 6e 64 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 nd} {socket} {.
28a0: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
28b0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
28c0: 76 65 72 20 63 61 6c 6c 62 61 63 6b 20 32 35 32 ver callback 252
28d0: 30 20 2d 2d 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 0 --} msg] $msg.
28e0: 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 20 61 72 } {1 {wrong # ar
28f0: 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 20 22 74 gs: should be "t
2900: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2910: 65 72 20 63 6f 6d 6d 61 6e 64 20 3f 6f 70 74 69 er command ?opti
2920: 6f 6e 73 3f 20 70 6f 72 74 22 7d 7d 0a 0a 74 65 ons? port"}}..te
2930: 73 74 20 74 6c 73 49 4f 2d 31 2e 31 32 20 7b 61 st tlsIO-1.12 {a
2940: 72 67 20 70 61 72 73 69 6e 67 20 66 6f 72 20 73 rg parsing for s
2950: 6f 63 6b 65 74 20 63 6f 6d 6d 61 6e 64 7d 20 7b ocket command} {
2960: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c 69 socket} {. li
2970: 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a st [catch {tls::
2980: 73 6f 63 6b 65 74 20 66 6f 6f 20 62 61 64 70 6f socket foo badpo
2990: 72 74 7d 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 rt} msg] $msg.}
29a0: 7b 31 20 7b 65 78 70 65 63 74 65 64 20 69 6e 74 {1 {expected int
29b0: 65 67 65 72 20 62 75 74 20 67 6f 74 20 22 62 61 eger but got "ba
29c0: 64 70 6f 72 74 22 7d 7d 0a 0a 74 65 73 74 20 74 dport"}}..test t
29d0: 6c 73 49 4f 2d 32 2e 31 20 7b 74 63 70 20 63 6f lsIO-2.1 {tcp co
29e0: 6e 6e 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 nnection} {socke
29f0: 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 t stdio} {. r
2a00: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
2a10: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
2a20: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
2a30: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
2a40: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
2a50: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
2a60: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
2a70: 71 75 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 quire tls..set t
2a80: 69 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 imer [after 2000
2a90: 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 "set x timed_ou
2aa0: 74 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 t"]. }. pu
2ab0: 74 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 ts $f "set f \[t
2ac0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
2ad0: 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 er accept -certf
2ae0: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
2af0: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
2b00: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
2b10: 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 Key 8828 \]".
2b20: 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 puts $f {..proc
2b30: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 accept {file ad
2b40: 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 dr port} {..
2b50: 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 global x.. se
2b60: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
2b70: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 close $file
2b80: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
2b90: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
2ba0: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
2bb0: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 lose $f..puts $x
2bc0: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
2bd0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
2be0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
2bf0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
2c00: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
2c10: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
2c20: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
2c30: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
2c40: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
2c50: 69 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d ile $caCert \..-
2c60: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
2c70: 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 ey 127.0.0.1 882
2c80: 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 20 20 20 8} msg]} {.
2c90: 20 20 20 73 65 74 20 78 20 24 6d 73 67 0a 20 20 set x $msg.
2ca0: 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 } else {.
2cb0: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
2cc0: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
2cd0: 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d 0a lose $msg. }.
2ce0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
2cf0: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
2d00: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
2d10: 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 7b 7d 7d {ready done {}}
2d20: 0a 0a 69 66 20 5b 69 6e 66 6f 20 65 78 69 73 74 ..if [info exist
2d30: 73 20 70 6f 72 74 5d 20 7b 0a 20 20 20 20 69 6e s port] {. in
2d40: 63 72 20 70 6f 72 74 0a 7d 20 65 6c 73 65 20 7b cr port.} else {
2d50: 0a 20 20 20 20 73 65 74 20 70 6f 72 74 20 5b 65 . set port [e
2d60: 78 70 72 20 7b 24 74 6c 73 53 65 72 76 65 72 50 xpr {$tlsServerP
2d70: 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 34 ort + [pid]%1024
2d80: 7d 5d 0a 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f }].}..test tlsIO
2d90: 2d 32 2e 32 20 7b 74 63 70 20 63 6f 6e 6e 65 63 -2.2 {tcp connec
2da0: 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 6e 74 tion with client
2db0: 20 70 6f 72 74 20 73 70 65 63 69 66 69 65 64 7d port specified}
2dc0: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
2dd0: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
2de0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
2df0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
2e00: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
2e10: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
2e20: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
2e30: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
2e40: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
2e50: 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 ..set timer [aft
2e60: 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 64 er 2000 "set x d
2e70: 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 one"]. }.
2e80: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
2e90: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
2ea0: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
2eb0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
2ec0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
2ed0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
2ee0: 65 72 4b 65 79 20 38 38 32 39 20 5c 5d 22 0a 20 erKey 8829 \]".
2ef0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
2f00: 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 oc accept {sock
2f10: 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 addr port} {.
2f20: 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 global
2f30: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 x. pu
2f40: 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d ts "[gets $sock]
2f50: 20 24 70 6f 72 74 22 0a 20 20 20 20 20 20 20 20 $port".
2f60: 20 20 20 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a close $sock.
2f70: 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 set
2f80: 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 20 x done..}..puts
2f90: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
2fa0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
2fb0: 6d 65 72 0a 09 63 6c 6f 73 65 20 24 66 0a 20 20 mer..close $f.
2fc0: 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 }. close $f
2fd0: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
2fe0: 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 "|[list $::tclt
2ff0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 est::tcltest scr
3000: 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 65 74 ipt]" r]. get
3010: 73 20 24 66 20 78 0a 20 20 20 20 67 6c 6f 62 61 s $f x. globa
3020: 6c 20 70 6f 72 74 0a 20 20 20 20 69 66 20 7b 5b l port. if {[
3030: 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b catch {tls::sock
3040: 65 74 20 2d 6d 79 70 6f 72 74 20 24 70 6f 72 74 et -myport $port
3050: 20 5c 0a 09 2d 63 65 72 74 66 69 6c 65 20 24 63 \..-certfile $c
3060: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
3070: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
3080: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
3090: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 7d 127.0.0.1 8829}
30a0: 20 73 6f 63 6b 5d 7d 20 7b 0a 20 20 20 20 20 20 sock]} {.
30b0: 20 20 73 65 74 20 78 20 24 73 6f 63 6b 0a 09 63 set x $sock..c
30c0: 61 74 63 68 20 7b 63 6c 6f 73 65 20 5b 74 6c 73 atch {close [tls
30d0: 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 ::socket 127.0.0
30e0: 2e 31 20 38 38 32 39 5d 7d 0a 20 20 20 20 7d 20 .1 8829]}. }
30f0: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 else {. p
3100: 75 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a uts $sock hello.
3110: 09 66 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 .flush $sock.
3120: 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b lappend x [
3130: 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 gets $f].
3140: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
3150: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
3160: 20 20 20 20 73 65 74 20 78 0a 7d 20 5b 6c 69 73 set x.} [lis
3170: 74 20 72 65 61 64 79 20 22 68 65 6c 6c 6f 20 24 t ready "hello $
3180: 70 6f 72 74 22 5d 0a 0a 74 65 73 74 20 74 6c 73 port"]..test tls
3190: 49 4f 2d 32 2e 33 20 7b 74 63 70 20 63 6f 6e 6e IO-2.3 {tcp conn
31a0: 65 63 74 69 6f 6e 20 77 69 74 68 20 63 6c 69 65 ection with clie
31b0: 6e 74 20 69 6e 74 65 72 66 61 63 65 20 73 70 65 nt interface spe
31c0: 63 69 66 69 65 64 7d 20 7b 73 6f 63 6b 65 74 20 cified} {socket
31d0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
31e0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
31f0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3200: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3210: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
3220: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
3230: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
3240: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
3250: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
3260: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
3270: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 set x done"].
3280: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
3290: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
32a0: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
32b0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
32c0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
32d0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
32e0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
32f0: 30 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 0 \]". puts $
3300: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
3310: 20 7b 73 6f 63 6b 20 61 64 64 72 20 70 6f 72 74 {sock addr port
3320: 7d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 } {.
3330: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
3340: 20 20 20 20 20 70 75 74 73 20 22 5b 67 65 74 73 puts "[gets
3350: 20 24 73 6f 63 6b 5d 20 24 61 64 64 72 22 0a 20 $sock] $addr".
3360: 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 close
3370: 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 20 20 $sock.
3380: 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 7d set x done..}
3390: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
33a0: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
33b0: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
33c0: 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 20 63 e $f. }. c
33d0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
33e0: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
33f0: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
3400: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d 0a est script]" r].
3410: 20 20 20 20 67 65 74 73 20 24 66 20 78 0a 20 20 gets $f x.
3420: 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c if {[catch {tl
3430: 73 3a 3a 73 6f 63 6b 65 74 20 2d 6d 79 61 64 64 s::socket -myadd
3440: 72 20 31 32 37 2e 30 2e 30 2e 31 20 5c 0a 09 2d r 127.0.0.1 \..-
3450: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
3460: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
3470: 43 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 Cert \..-keyfile
3480: 20 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e $clientKey 127.
3490: 30 2e 30 2e 31 20 38 38 33 30 7d 20 73 6f 63 6b 0.0.1 8830} sock
34a0: 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 ]} {. set
34b0: 20 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 x $sock. } e
34c0: 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 lse {. pu
34d0: 74 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 ts $sock hello..
34e0: 63 61 74 63 68 20 7b 66 6c 75 73 68 20 24 73 6f catch {flush $so
34f0: 63 6b 7d 0a 20 20 20 20 20 20 20 20 6c 61 70 70 ck}. lapp
3500: 65 6e 64 20 78 20 5b 67 65 74 73 20 24 66 5d 0a end x [gets $f].
3510: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3520: 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c ock. }. cl
3530: 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 ose $f. set x
3540: 0a 7d 20 7b 72 65 61 64 79 20 7b 68 65 6c 6c 6f .} {ready {hello
3550: 20 31 32 37 2e 30 2e 30 2e 31 7d 7d 0a 0a 74 65 127.0.0.1}}..te
3560: 73 74 20 74 6c 73 49 4f 2d 32 2e 34 20 7b 74 63 st tlsIO-2.4 {tc
3570: 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 77 69 74 p connection wit
3580: 68 20 73 65 72 76 65 72 20 69 6e 74 65 72 66 61 h server interfa
3590: 63 65 20 73 70 65 63 69 66 69 65 64 7d 20 7b 73 ce specified} {s
35a0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
35b0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
35c0: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
35d0: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
35e0: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
35f0: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
3600: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
3610: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
3620: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 09 73 e require tls..s
3630: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
3640: 32 30 30 30 20 22 73 65 74 20 78 20 64 6f 6e 65 2000 "set x done
3650: 22 5d 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 "]. }. put
3660: 73 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c s $f "set f \[tl
3670: 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 s::socket -serve
3680: 72 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 r accept -certfi
3690: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
36a0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
36b0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
36c0: 65 79 20 2d 6d 79 61 64 64 72 20 6c 6f 63 61 6c ey -myaddr local
36d0: 68 6f 73 74 20 38 38 33 31 20 5c 5d 22 0a 20 20 host 8831 \]".
36e0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 6f puts $f {..pro
36f0: 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b 20 61 c accept {sock a
3700: 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 20 20 ddr port} {.
3710: 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c 20 78 global x
3720: 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 . put
3730: 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b 5d 22 s "[gets $sock]"
3740: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f . clo
3750: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 se $sock.
3760: 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a set x done.
3770: 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 .}..puts ready..
3780: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
3790: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
37a0: 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 20 20 ose $f. }.
37b0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
37c0: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
37d0: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
37e0: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
37f0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 78 0a ]. gets $f x.
3800: 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 20 7b if {[catch {
3810: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 tls::socket -cer
3820: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
3830: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
3840: 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 t \..-keyfile $c
3850: 6c 69 65 6e 74 4b 65 79 20 6c 6f 63 61 6c 68 6f lientKey localho
3860: 73 74 20 38 38 33 31 7d 20 73 6f 63 6b 5d 7d 20 st 8831} sock]}
3870: 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 20 {. set x
3880: 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c 73 65 $sock. } else
3890: 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 73 20 {. puts
38a0: 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 6c 75 $sock hello..flu
38b0: 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 20 20 sh $sock.
38c0: 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 74 73 lappend x [gets
38d0: 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 6c 6f $f]. clo
38e0: 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 se $sock. }.
38f0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3900: 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 20 68 set x.} {ready h
3910: 65 6c 6c 6f 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ello}..test tlsI
3920: 4f 2d 32 2e 35 20 7b 74 63 70 20 63 6f 6e 6e 65 O-2.5 {tcp conne
3930: 63 74 69 6f 6e 20 77 69 74 68 20 72 65 64 75 6e ction with redun
3940: 64 61 6e 74 20 73 65 72 76 65 72 20 70 6f 72 74 dant server port
3950: 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d } {socket stdio}
3960: 20 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c {. removeFil
3970: 65 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 e script. set
3980: 20 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 f [open script
3990: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b w]. puts $f [
39a0: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
39b0: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
39c0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
39d0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
39e0: 73 0a 09 73 65 74 20 74 69 6d 65 72 20 5b 61 66 s..set timer [af
39f0: 74 65 72 20 32 30 30 30 20 22 73 65 74 20 78 20 ter 2000 "set x
3a00: 64 6f 6e 65 22 5d 0a 20 20 20 20 7d 0a 20 20 20 done"]. }.
3a10: 20 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 puts $f "set f
3a20: 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 \[tls::socket -s
3a30: 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 erver accept -ce
3a40: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
3a50: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
3a60: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
3a70: 76 65 72 4b 65 79 20 38 38 33 32 20 5c 5d 22 0a verKey 8832 \]".
3a80: 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 puts $f {..p
3a90: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 6f 63 6b roc accept {sock
3aa0: 20 61 64 64 72 20 70 6f 72 74 7d 20 7b 0a 20 20 addr port} {.
3ab0: 20 20 20 20 20 20 20 20 20 20 67 6c 6f 62 61 6c global
3ac0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 70 x. p
3ad0: 75 74 73 20 22 5b 67 65 74 73 20 24 73 6f 63 6b uts "[gets $sock
3ae0: 5d 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 ]". c
3af0: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 20 lose $sock.
3b00: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
3b10: 65 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 e..}..puts ready
3b20: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
3b30: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 cancel $timer..
3b40: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 7d 0a 20 close $f. }.
3b50: 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 close $f.
3b60: 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c set f [open "|[l
3b70: 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a ist $::tcltest::
3b80: 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 tcltest script]"
3b90: 20 72 5d 0a 20 20 20 20 67 65 74 73 20 24 66 20 r]. gets $f
3ba0: 78 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 x. if {[catch
3bb0: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 {tls::socket -c
3bc0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
3bd0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
3be0: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
3bf0: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
3c00: 2e 30 2e 31 20 38 38 33 32 7d 20 73 6f 63 6b 5d .0.1 8832} sock]
3c10: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
3c20: 78 20 24 73 6f 63 6b 0a 20 20 20 20 7d 20 65 6c x $sock. } el
3c30: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 70 75 74 se {. put
3c40: 73 20 24 73 6f 63 6b 20 68 65 6c 6c 6f 0a 09 66 s $sock hello..f
3c50: 6c 75 73 68 20 24 73 6f 63 6b 0a 20 20 20 20 20 lush $sock.
3c60: 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 65 lappend x [ge
3c70: 74 73 20 24 66 5d 0a 20 20 20 20 20 20 20 20 63 ts $f]. c
3c80: 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 20 7d lose $sock. }
3c90: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 . close $f.
3ca0: 20 20 73 65 74 20 78 0a 7d 20 7b 72 65 61 64 79 set x.} {ready
3cb0: 20 68 65 6c 6c 6f 7d 0a 74 65 73 74 20 74 6c 73 hello}.test tls
3cc0: 49 4f 2d 32 2e 36 20 7b 74 63 70 20 63 6f 6e 6e IO-2.6 {tcp conn
3cd0: 65 63 74 69 6f 6e 7d 20 7b 73 6f 63 6b 65 74 7d ection} {socket}
3ce0: 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 {. set statu
3cf0: 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 5b 63 s ok. if {![c
3d00: 61 74 63 68 20 7b 73 65 74 20 73 6f 63 6b 20 5b atch {set sock [
3d10: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 31 32 37 2e tls::socket 127.
3d20: 30 2e 30 2e 31 20 38 38 33 33 5d 7d 5d 7d 20 7b 0.0.1 8833]}]} {
3d30: 0a 09 69 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 ..if {![catch {g
3d40: 65 74 73 20 24 73 6f 63 6b 7d 5d 7d 20 7b 0a 09 ets $sock}]} {..
3d50: 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 62 set status b
3d60: 72 6f 6b 65 6e 0a 09 7d 0a 09 63 6c 6f 73 65 20 roken..}..close
3d70: 24 73 6f 63 6b 0a 20 20 20 20 7d 0a 20 20 20 20 $sock. }.
3d80: 73 65 74 20 73 74 61 74 75 73 0a 7d 20 6f 6b 0a set status.} ok.
3d90: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 37 20 .test tlsIO-2.7
3da0: 7b 65 63 68 6f 20 73 65 72 76 65 72 2c 20 6f 6e {echo server, on
3db0: 65 20 6c 69 6e 65 7d 20 7b 73 6f 63 6b 65 74 20 e line} {socket
3dc0: 73 74 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d stdio} {. rem
3dd0: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
3de0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
3df0: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
3e00: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
3e10: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
3e20: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
3e30: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
3e40: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
3e50: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
3e60: 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 20 20 20 set x done"].
3e70: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
3e80: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
3e90: 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 ket -server acce
3ea0: 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 pt -certfile $se
3eb0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
3ec0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
3ed0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 e $serverKey 883
3ee0: 34 20 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 24 4 \]". puts $
3ef0: 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 70 74 f {..proc accept
3f00: 20 7b 73 20 61 20 70 7d 20 7b 0a 20 20 20 20 20 {s a p} {.
3f10: 20 20 20 20 20 20 20 66 69 6c 65 65 76 65 6e 74 fileevent
3f20: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
3f30: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
3f40: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
3f50: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 20 2d translation lf -
3f60: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
3f70: 20 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 }..proc e
3f80: 63 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 cho {s} {..
3f90: 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a set l [gets $s].
3fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
3fb0: 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 {[eof $s]} {.
3fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67 6c gl
3fd0: 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 obal x.
3fe0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
3ff0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4000: 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 20 20 set x done.
4010: 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c 73 65 } else
4020: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
4030: 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a 20 puts $s $l.
4040: 20 20 20 20 20 20 20 20 20 20 20 20 7d 0a 09 7d }..}
4050: 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 76 77 ..puts ready..vw
4060: 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e ait x..after can
4070: 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c 6f 73 cel $timer..clos
4080: 65 20 24 66 0a 09 70 75 74 73 20 64 6f 6e 65 0a e $f..puts done.
4090: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
40a0: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
40b0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
40c0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
40d0: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
40e0: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 ets $f. set s
40f0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 [tls::socket -c
4100: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
4110: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
4120: 65 72 74 20 5c 0a 09 2d 6b 65 79 66 69 6c 65 20 ert \..-keyfile
4130: 24 63 6c 69 65 6e 74 4b 65 79 20 31 32 37 2e 30 $clientKey 127.0
4140: 2e 30 2e 31 20 38 38 33 34 5d 0a 20 20 20 20 66 .0.1 8834]. f
4150: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 configure $s -bu
4160: 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d 74 72 ffering line -tr
4170: 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 0a 20 20 20 anslation lf.
4180: 20 70 75 74 73 20 24 73 20 22 68 65 6c 6c 6f 20 puts $s "hello
4190: 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 abcdefghijklmnop
41a0: 22 0a 20 20 20 20 61 66 74 65 72 20 31 30 30 30 ". after 1000
41b0: 0a 20 20 20 20 73 65 74 20 78 20 5b 67 65 74 73 . set x [gets
41c0: 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 $s]. close $
41d0: 73 0a 20 20 20 20 73 65 74 20 79 20 5b 67 65 74 s. set y [get
41e0: 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $f]. close
41f0: 24 66 0a 20 20 20 20 6c 69 73 74 20 24 78 20 24 $f. list $x $
4200: 79 0a 7d 20 7b 7b 68 65 6c 6c 6f 20 61 62 63 64 y.} {{hello abcd
4210: 65 66 67 68 69 6a 6b 6c 6d 6e 6f 70 7d 20 64 6f efghijklmnop} do
4220: 6e 65 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d ne}..test tlsIO-
4230: 32 2e 38 20 7b 65 63 68 6f 20 73 65 72 76 65 72 2.8 {echo server
4240: 2c 20 6c 6f 6f 70 20 35 30 20 74 69 6d 65 73 2c , loop 50 times,
4250: 20 73 69 6e 67 6c 65 20 63 6f 6e 6e 65 63 74 69 single connecti
4260: 6f 6e 7d 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 on} {socket stdi
4270: 6f 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 20 5b o} {. set f [
4280: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
4290: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
42a0: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
42b0: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
42c0: 75 74 73 20 24 66 20 7b 0a 20 20 20 20 09 70 61 uts $f {. .pa
42d0: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
42e0: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
42f0: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
4300: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
4310: 20 61 63 63 65 70 74 20 2d 63 65 72 74 66 69 6c accept -certfil
4320: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
4330: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
4340: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
4350: 79 20 38 38 33 35 20 5c 5d 22 0a 20 20 20 20 70 y 8835 \]". p
4360: 75 74 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 uts $f {..proc a
4370: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a ccept {s a p} {.
4380: 20 20 20 20 20 20 20 20 20 20 20 20 66 69 6c 65 file
4390: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
43a0: 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d e [list echo $s]
43b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 63 6f . fco
43c0: 6e 66 69 67 75 72 65 20 24 73 20 2d 62 75 66 66 nfigure $s -buff
43d0: 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 20 ering line.
43e0: 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 }..proc echo
43f0: 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f 62 {s} {.. glob
4400: 61 6c 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 al i.
4410: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
4420: 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 69 ]. i
4430: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 f {[eof $s]} {.
4440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4450: 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 20 20 20 global x.
4460: 20 20 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 close
4470: 24 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 $s.
4480: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 20 set x done.
4490: 20 20 20 20 20 20 20 20 20 20 20 20 7d 20 65 6c } el
44a0: 73 65 20 7b 0a 09 20 20 20 20 20 20 20 20 20 69 se {.. i
44b0: 6e 63 72 20 69 0a 20 20 20 20 20 20 20 20 20 20 ncr i.
44c0: 20 20 20 20 20 20 20 70 75 74 73 20 24 73 20 24 puts $s $
44d0: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d l. }
44e0: 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a 09 70 75 ..}..set i 0..pu
44f0: 74 73 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 ts ready..set ti
4500: 6d 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 30 mer [after 20000
4510: 20 22 73 65 74 20 78 20 64 6f 6e 65 22 5d 0a 09 "set x done"]..
4520: 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 63 vwait x..after c
4530: 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 6c ancel $timer..cl
4540: 6f 73 65 20 24 66 0a 09 70 75 74 73 20 22 64 6f ose $f..puts "do
4550: 6e 65 20 24 69 22 0a 20 20 20 20 7d 0a 20 20 20 ne $i". }.
4560: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
4570: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
4580: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
4590: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
45a0: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
45b0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
45c0: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
45d0: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
45e0: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
45f0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
4600: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 33 35 y 127.0.0.1 8835
4610: 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 ]. fconfigure
4620: 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c $s -buffering l
4630: 69 6e 65 0a 20 20 20 20 63 61 74 63 68 20 7b 0a ine. catch {.
4640: 09 66 6f 72 20 7b 73 65 74 20 78 20 30 7d 20 7b .for {set x 0} {
4650: 24 78 20 3c 20 35 30 7d 20 7b 69 6e 63 72 20 78 $x < 50} {incr x
4660: 7d 20 7b 0a 09 20 20 20 20 70 75 74 73 20 24 73 } {.. puts $s
4670: 20 22 68 65 6c 6c 6f 20 61 62 63 64 65 66 67 68 "hello abcdefgh
4680: 69 6a 6b 6c 6d 6e 6f 70 22 0a 09 20 20 20 20 67 ijklmnop".. g
4690: 65 74 73 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a ets $s..}. }.
46a0: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
46b0: 20 63 61 74 63 68 20 7b 73 65 74 20 78 20 5b 67 catch {set x [g
46c0: 65 74 73 20 24 66 5d 7d 0a 20 20 20 20 63 6c 6f ets $f]}. clo
46d0: 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a se $f. set x.
46e0: 7d 20 7b 64 6f 6e 65 20 35 30 7d 0a 0a 74 65 73 } {done 50}..tes
46f0: 74 20 74 6c 73 49 4f 2d 32 2e 39 20 7b 73 6f 63 t tlsIO-2.9 {soc
4700: 6b 65 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 ket conflict} {s
4710: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
4720: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
4730: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
4740: 63 65 70 74 20 38 38 32 38 5d 0a 20 20 20 20 72 cept 8828]. r
4750: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
4760: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
4770: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
4780: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
4790: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
47a0: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
47b0: 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 66 20 7b 0a -nonewline $f {.
47c0: 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 .package require
47d0: 20 74 6c 73 0a 09 74 6c 73 3a 3a 73 6f 63 6b 65 tls..tls::socke
47e0: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
47f0: 20 38 38 32 38 0a 20 20 20 20 7d 0a 20 20 20 20 8828. }.
4800: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 close $f. set
4810: 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 f [open "|[list
4820: 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c $::tcltest::tcl
4830: 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 5d test script]" r]
4840: 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 20 . gets $f.
4850: 20 61 66 74 65 72 20 31 30 30 0a 20 20 20 20 73 after 100. s
4860: 65 74 20 78 20 5b 6c 69 73 74 20 5b 63 61 74 63 et x [list [catc
4870: 68 20 7b 63 6c 6f 73 65 20 24 66 7d 20 6d 73 67 h {close $f} msg
4880: 5d 20 5b 73 74 72 69 6e 67 20 72 61 6e 67 65 20 ] [string range
4890: 24 6d 73 67 20 30 20 34 33 5d 5d 0a 20 20 20 20 $msg 0 43]].
48a0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 65 74 close $s. set
48b0: 20 78 0a 7d 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 x.} {1 {couldn'
48c0: 74 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 t open socket: a
48d0: 64 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 ddress already i
48e0: 6e 20 75 73 65 7d 7d 0a 0a 74 65 73 74 20 74 6c n use}}..test tl
48f0: 73 49 4f 2d 32 2e 31 30 20 7b 63 6c 6f 73 65 20 sIO-2.10 {close
4900: 6f 6e 20 61 63 63 65 70 74 2c 20 61 63 63 65 70 on accept, accep
4910: 74 65 64 20 73 6f 63 6b 65 74 20 6c 69 76 65 73 ted socket lives
4920: 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 } {socket} {.
4930: 20 73 65 74 20 64 6f 6e 65 20 30 0a 20 20 20 20 set done 0.
4940: 73 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 set timer [after
4950: 20 32 30 30 30 30 20 22 73 65 74 20 64 6f 6e 65 20000 "set done
4960: 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 timed_out"].
4970: 20 73 65 74 20 73 73 20 5b 74 6c 73 3a 3a 73 6f set ss [tls::so
4980: 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 cket -server acc
4990: 65 70 74 20 2d 63 65 72 74 66 69 6c 65 20 24 73 ept -certfile $s
49a0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
49b0: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b 65 e $caCert \..-ke
49c0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
49d0: 20 38 38 33 30 5d 0a 20 20 20 20 70 72 6f 63 20 8830]. proc
49e0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
49f0: 0a 09 67 6c 6f 62 61 6c 20 73 73 0a 09 63 6c 6f ..global ss..clo
4a00: 73 65 20 24 73 73 0a 09 66 69 6c 65 65 76 65 6e se $ss..fileeven
4a10: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 22 72 t $s readable "r
4a20: 65 61 64 69 74 20 24 73 22 0a 09 66 63 6f 6e 66 eadit $s"..fconf
4a30: 69 67 75 72 65 20 24 73 20 2d 74 72 61 6e 73 20 igure $s -trans
4a40: 6c 66 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f lf. }. pro
4a50: 63 20 72 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 c readit {s} {..
4a60: 67 6c 6f 62 61 6c 20 64 6f 6e 65 0a 09 67 65 74 global done..get
4a70: 73 20 24 73 0a 09 63 6c 6f 73 65 20 24 73 0a 09 s $s..close $s..
4a80: 73 65 74 20 64 6f 6e 65 20 31 0a 20 20 20 20 7d set done 1. }
4a90: 0a 20 20 20 20 73 65 74 20 63 73 20 5b 74 6c 73 . set cs [tls
4aa0: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
4ab0: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
4ac0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 5c cafile $caCert \
4ad0: 0a 09 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 ..-keyfile $clie
4ae0: 6e 74 4b 65 79 20 6c 6f 63 61 6c 68 6f 73 74 20 ntKey localhost
4af0: 38 38 33 30 5d 0a 20 20 20 20 63 6c 6f 73 65 20 8830]. close
4b00: 24 63 73 0a 0a 20 20 20 20 76 77 61 69 74 20 64 $cs.. vwait d
4b10: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
4b20: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
4b30: 73 65 74 20 64 6f 6e 65 0a 7d 20 31 0a 0a 74 65 set done.} 1..te
4b40: 73 74 20 74 6c 73 49 4f 2d 32 2e 31 31 20 7b 64 st tlsIO-2.11 {d
4b50: 65 74 65 63 74 69 6e 67 20 6e 65 77 20 64 61 74 etecting new dat
4b60: 61 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 a} {socket} {.
4b70: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
4b80: 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 a p} {..global
4b90: 73 6f 63 6b 0a 09 23 20 77 68 65 6e 20 64 6f 69 sock..# when doi
4ba0: 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 ng an in-process
4bb0: 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 client/server t
4bc0: 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 est, both sides
4bd0: 6e 65 65 64 0a 09 23 20 74 6f 20 62 65 20 6e 6f need..# to be no
4be0: 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 74 n-blocking for t
4bf0: 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 he TLS handshake
4c00: 2e 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 . Also make sur
4c10: 65 0a 09 23 20 74 6f 20 72 65 74 75 72 6e 20 74 e..# to return t
4c20: 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f 20 6c 69 he channel to li
4c30: 6e 65 20 62 75 66 66 65 72 69 6e 67 20 6d 6f 64 ne buffering mod
4c40: 65 2e 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 e...fconfigure $
4c50: 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 s -blocking 0 -b
4c60: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 73 uffering line..s
4c70: 65 74 20 73 6f 63 6b 20 24 73 0a 09 66 69 6c 65 et sock $s..file
4c80: 65 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c event $s readabl
4c90: 65 20 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 e [list do_hands
4ca0: 68 61 6b 65 20 24 73 5d 0a 20 20 20 20 7d 0a 0a hake $s]. }..
4cb0: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
4cc0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
4cd0: 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d 63 65 ccept \.. -ce
4ce0: 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 rtfile $serverCe
4cf0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
4d00: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 rt -keyfile $ser
4d10: 76 65 72 4b 65 79 20 38 34 30 30 5d 0a 20 20 20 verKey 8400].
4d20: 20 73 65 74 20 73 6f 63 6b 20 22 22 0a 20 20 20 set sock "".
4d30: 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f set s2 [tls::so
4d40: 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 cket -certfile $
4d50: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
4d60: 6c 65 20 24 63 61 43 65 72 74 20 5c 0a 09 2d 6b le $caCert \..-k
4d70: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
4d80: 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 34 30 30 y 127.0.0.1 8400
4d90: 5d 0a 20 20 20 20 23 20 77 68 65 6e 20 64 6f 69 ]. # when doi
4da0: 6e 67 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 ng an in-process
4db0: 20 63 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 client/server t
4dc0: 65 73 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 est, both sides
4dd0: 6e 65 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 need. # to be
4de0: 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f non-blocking fo
4df0: 72 20 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 r the TLS handsh
4e00: 61 6b 65 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 ake Also make s
4e10: 75 72 65 20 74 6f 0a 20 20 20 20 23 20 72 65 74 ure to. # ret
4e20: 75 72 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 urn the channel
4e30: 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e to line bufferin
4e40: 67 20 6d 6f 64 65 20 28 54 4c 53 20 73 65 74 73 g mode (TLS sets
4e50: 20 69 74 20 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a it to 'none')..
4e60: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
4e70: 73 32 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d s2 -blocking 0 -
4e80: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
4e90: 20 20 20 76 77 61 69 74 20 73 6f 63 6b 0a 20 20 vwait sock.
4ea0: 20 20 70 75 74 73 20 24 73 32 20 6f 6e 65 0a 20 puts $s2 one.
4eb0: 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 20 flush $s2.
4ec0: 20 23 20 6e 65 65 64 20 75 70 64 61 74 65 20 74 # need update t
4ed0: 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c 53 20 68 o complete TLS h
4ee0: 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 72 6f 63 andshake in-proc
4ef0: 65 73 73 0a 20 20 20 20 75 70 64 61 74 65 0a 20 ess. update.
4f00: 20 20 20 61 66 74 65 72 20 35 30 30 0a 20 20 20 after 500.
4f10: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f 63 fconfigure $soc
4f20: 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 k -blocking 0.
4f30: 20 20 73 65 74 20 72 65 73 75 6c 74 20 61 3a 5b set result a:[
4f40: 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 20 20 gets $sock].
4f50: 6c 61 70 70 65 6e 64 20 72 65 73 75 6c 74 20 62 lappend result b
4f60: 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d 0a 20 20 :[gets $sock].
4f70: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
4f80: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 ck -blocking 1.
4f90: 20 20 20 70 75 74 73 20 24 73 32 20 74 77 6f 0a puts $s2 two.
4fa0: 20 20 20 20 66 6c 75 73 68 20 24 73 32 0a 20 20 flush $s2.
4fb0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 6f fconfigure $so
4fc0: 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 0a 20 ck -blocking 1.
4fd0: 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 75 6c lappend resul
4fe0: 74 20 63 3a 5b 67 65 74 73 20 24 73 6f 63 6b 5d t c:[gets $sock]
4ff0: 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5000: 24 73 6f 63 6b 20 2d 62 6c 6f 63 6b 69 6e 67 20 $sock -blocking
5010: 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 32 0a 1. close $s2.
5020: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
5030: 20 63 6c 6f 73 65 20 24 73 6f 63 6b 0a 20 20 20 close $sock.
5040: 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 7b 61 set result.} {a
5050: 3a 6f 6e 65 20 62 3a 20 63 3a 74 77 6f 7d 0a 0a :one b: c:two}..
5060: 74 65 73 74 20 74 6c 73 49 4f 2d 32 2e 31 32 20 test tlsIO-2.12
5070: 7b 74 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 3b {tcp connection;
5080: 20 6e 6f 20 63 65 72 74 69 66 69 63 61 74 65 73 no certificates
5090: 20 73 70 65 63 69 66 69 65 64 7d 20 5c 0a 09 7b specified} \..{
50a0: 73 6f 63 6b 65 74 20 73 74 64 69 6f 20 75 6e 69 socket stdio uni
50b0: 78 4f 6e 6c 79 7d 20 7b 0a 20 20 20 20 23 20 54 xOnly} {. # T
50c0: 68 65 72 65 20 69 73 20 61 20 64 65 62 75 67 20 here is a debug
50d0: 61 73 73 65 72 74 69 6f 6e 20 6f 6e 20 57 69 6e assertion on Win
50e0: 64 6f 77 73 2f 53 53 4c 20 74 68 61 74 20 63 61 dows/SSL that ca
50f0: 75 73 65 73 20 61 20 63 72 61 73 68 20 77 68 65 uses a crash whe
5100: 6e 20 74 68 65 0a 20 20 20 20 23 20 63 65 72 74 n the. # cert
5110: 69 66 69 63 61 74 65 20 69 73 6e 27 74 20 73 70 ificate isn't sp
5120: 65 63 69 66 69 65 64 2e 0a 20 20 20 20 72 65 6d ecified.. rem
5130: 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 oveFile script.
5140: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
5150: 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 cript w]. put
5160: 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 s $f [list set a
5170: 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 uto_path $auto_p
5180: 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 ath]. puts $f
5190: 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 {..package requ
51a0: 69 72 65 20 74 6c 73 0a 09 73 65 74 20 74 69 6d ire tls..set tim
51b0: 65 72 20 5b 61 66 74 65 72 20 32 30 30 30 20 22 er [after 2000 "
51c0: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
51d0: 5d 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a 73 ]..set f [tls::s
51e0: 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 63 ocket -server ac
51f0: 63 65 70 74 20 38 38 32 38 5d 0a 09 70 72 6f 63 cept 8828]..proc
5200: 20 61 63 63 65 70 74 20 7b 66 69 6c 65 20 61 64 accept {file ad
5210: 64 72 20 70 6f 72 74 7d 20 7b 0a 09 20 20 20 20 dr port} {..
5220: 67 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 global x.. se
5230: 74 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 t x done.
5240: 20 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c 65 close $file
5250: 0a 09 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a ..}..puts ready.
5260: 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 20 .vwait x..after
5270: 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 09 63 cancel $timer..c
5280: 6c 6f 73 65 20 24 66 0a 09 70 75 74 73 20 24 78 lose $f..puts $x
5290: 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 . }. close
52a0: 20 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f $f. set f [o
52b0: 70 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 pen "|[list $::t
52c0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
52d0: 73 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 script]" r].
52e0: 67 65 74 73 20 24 66 20 78 0a 20 20 20 20 69 66 gets $f x. if
52f0: 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 73 {[catch {tls::s
5300: 6f 63 6b 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 ocket 127.0.0.1
5310: 38 38 32 38 7d 20 6d 73 67 5d 7d 20 7b 0a 20 20 8828} msg]} {.
5320: 20 20 20 20 20 20 73 65 74 20 78 20 24 6d 73 67 set x $msg
5330: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 . } else {.
5340: 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 lappend x
5350: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 20 20 [gets $f].
5360: 20 20 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 close $msg.
5370: 20 7d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 78 }. lappend x
5380: 20 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 63 [gets $f]. c
5390: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
53a0: 78 0a 7d 20 7b 72 65 61 64 79 20 64 6f 6e 65 20 x.} {ready done
53b0: 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d {}}..test tlsIO-
53c0: 33 2e 31 20 7b 73 6f 63 6b 65 74 20 63 6f 6e 66 3.1 {socket conf
53d0: 6c 69 63 74 7d 20 7b 73 6f 63 6b 65 74 20 73 74 lict} {socket st
53e0: 64 69 6f 7d 20 7b 0a 20 20 20 20 72 65 6d 6f 76 dio} {. remov
53f0: 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 eFile script.
5400: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 72 set f [open scr
5410: 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 20 ipt w]. puts
5420: 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 74 $f [list set aut
5430: 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 74 o_path $auto_pat
5440: 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b h]. puts $f {
5450: 0a 09 70 61 63 6b 61 67 65 20 72 65 71 75 69 72 ..package requir
5460: 65 20 74 6c 73 0a 20 20 20 20 7d 0a 20 20 20 20 e tls. }.
5470: 70 75 74 73 20 24 66 20 22 73 65 74 20 66 20 5c puts $f "set f \
5480: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
5490: 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 65 72 rver accept -cer
54a0: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
54b0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
54c0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
54d0: 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 0a 20 erKey 8828 \]".
54e0: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 75 puts $f {..pu
54f0: 74 73 20 72 65 61 64 79 0a 09 67 65 74 73 20 73 ts ready..gets s
5500: 74 64 69 6e 0a 09 63 6c 6f 73 65 20 24 66 0a 20 tdin..close $f.
5510: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
5520: 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 f. set f [ope
5530: 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c n "|[list $::tcl
5540: 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 test::tcltest sc
5550: 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 67 ript]" r+]. g
5560: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 78 ets $f. set x
5570: 20 5b 6c 69 73 74 20 5b 63 61 74 63 68 20 7b 74 [list [catch {t
5580: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
5590: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
55a0: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
55b0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
55c0: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 $clientKey \.
55d0: 20 20 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 .-server accep
55e0: 74 20 38 38 32 38 7d 20 6d 73 67 5d 20 5c 0a 09 t 8828} msg] \..
55f0: 09 24 6d 73 67 5d 0a 20 20 20 20 70 75 74 73 20 .$msg]. puts
5600: 24 66 20 62 79 65 0a 20 20 20 20 63 6c 6f 73 65 $f bye. close
5610: 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 $f. set x.}
5620: 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 {1 {couldn't ope
5630: 6e 20 73 6f 63 6b 65 74 3a 20 61 64 64 72 65 73 n socket: addres
5640: 73 20 61 6c 72 65 61 64 79 20 69 6e 20 75 73 65 s already in use
5650: 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 33 }}..test tlsIO-3
5660: 2e 32 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 .2 {server with
5670: 73 65 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d several clients}
5680: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
5690: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
56a0: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
56b0: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
56c0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
56d0: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
56e0: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
56f0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
5700: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
5710: 0a 09 73 65 74 20 74 31 20 5b 61 66 74 65 72 20 ..set t1 [after
5720: 33 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 30000 "set x tim
5730: 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 74 32 ed_out"]..set t2
5740: 20 5b 61 66 74 65 72 20 33 31 30 30 30 20 22 73 [after 31000 "s
5750: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
5760: 0a 09 73 65 74 20 74 33 20 5b 61 66 74 65 72 20 ..set t3 [after
5770: 33 32 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 32000 "set x tim
5780: 65 64 5f 6f 75 74 22 5d 0a 09 73 65 74 20 63 6f ed_out"]..set co
5790: 75 6e 74 65 72 20 30 0a 20 20 20 20 7d 0a 20 20 unter 0. }.
57a0: 20 20 70 75 74 73 20 24 66 20 22 73 65 74 20 73 puts $f "set s
57b0: 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d \[tls::socket -
57c0: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d 63 server accept -c
57d0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
57e0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
57f0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
5800: 72 76 65 72 4b 65 79 20 38 38 32 38 20 5c 5d 22 rverKey 8828 \]"
5810: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
5820: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
5830: 20 70 7d 20 7b 0a 09 20 20 20 20 66 69 6c 65 65 p} {.. filee
5840: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
5850: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
5860: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
5870: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
5880: 6e 65 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f ne..}..proc echo
5890: 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 6c 6f {s} {.. glo
58a0: 62 61 6c 20 78 0a 20 20 20 20 20 20 20 20 20 20 bal x.
58b0: 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 set l [gets $
58c0: 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s].
58d0: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
58e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58f0: 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 20 20 close $s.
5900: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78 set x
5910: 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 20 20 done.
5920: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
5930: 20 20 20 20 20 20 20 20 20 20 20 20 20 70 75 74 put
5940: 73 20 24 73 20 24 6c 0a 20 20 20 20 20 20 20 20 s $s $l.
5950: 20 20 20 20 20 7d 0a 09 7d 0a 09 70 75 74 73 20 }..}..puts
5960: 72 65 61 64 79 0a 09 76 77 61 69 74 20 78 0a 09 ready..vwait x..
5970: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 31 after cancel $t1
5980: 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 72 ..vwait x..after
5990: 20 63 61 6e 63 65 6c 20 24 74 32 0a 09 76 77 61 cancel $t2..vwa
59a0: 69 74 20 78 0a 09 61 66 74 65 72 20 63 61 6e 63 it x..after canc
59b0: 65 6c 20 24 74 33 0a 09 63 6c 6f 73 65 20 24 73 el $t3..close $s
59c0: 0a 09 70 75 74 73 20 24 78 0a 20 20 20 20 7d 0a ..puts $x. }.
59d0: 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 close $f.
59e0: 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b set f [open "|[
59f0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5a00: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5a10: 22 20 72 2b 5d 0a 20 20 20 20 73 65 74 20 78 20 " r+]. set x
5a20: 5b 67 65 74 73 20 24 66 5d 0a 20 20 20 20 73 65 [gets $f]. se
5a30: 74 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 t s1 [tls::socke
5a40: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
5a50: 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d le $clientCert -
5a60: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
5a70: 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b keyfile $clientK
5a80: 65 79 20 5c 0a 09 20 20 20 20 31 32 37 2e 30 2e ey \.. 127.0.
5a90: 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 20 66 63 0.1 8828]. fc
5aa0: 6f 6e 66 69 67 75 72 65 20 24 73 31 20 2d 62 75 onfigure $s1 -bu
5ab0: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
5ac0: 20 73 65 74 20 73 32 20 5b 74 6c 73 3a 3a 73 6f set s2 [tls::so
5ad0: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
5ae0: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
5af0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
5b00: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
5b10: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
5b20: 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 20 20 20 .0.0.1 8828].
5b30: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 20 fconfigure $s2
5b40: 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a -buffering line.
5b50: 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 3a set s3 [tls:
5b60: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
5b70: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
5b80: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
5b90: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
5ba0: 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 lientKey \..
5bb0: 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 5d 0a 127.0.0.1 8828].
5bc0: 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 fconfigure $
5bd0: 73 33 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 s3 -buffering li
5be0: 6e 65 0a 20 20 20 20 66 6f 72 20 7b 73 65 74 20 ne. for {set
5bf0: 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d 20 i 0} {$i < 100}
5c00: 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 70 75 74 73 {incr i} {..puts
5c10: 20 24 73 31 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f $s1 hello,tlsIO
5c20: 2d 33 2e 32 2c 73 31 0a 09 67 65 74 73 20 24 73 -3.2,s1..gets $s
5c30: 31 0a 09 70 75 74 73 20 24 73 32 20 68 65 6c 6c 1..puts $s2 hell
5c40: 6f 2c 74 6c 73 49 4f 2d 33 2e 32 2c 73 32 0a 09 o,tlsIO-3.2,s2..
5c50: 67 65 74 73 20 24 73 32 0a 09 70 75 74 73 20 24 gets $s2..puts $
5c60: 73 33 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d 33 s3 hello,tlsIO-3
5c70: 2e 32 2c 73 33 0a 09 67 65 74 73 20 24 73 33 0a .2,s3..gets $s3.
5c80: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
5c90: 24 73 31 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 $s1. close $s
5ca0: 32 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 33 0a 2. close $s3.
5cb0: 20 20 20 20 6c 61 70 70 65 6e 64 20 78 20 5b 67 lappend x [g
5cc0: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
5cd0: 65 20 24 66 0a 20 20 20 20 73 65 74 20 78 0a 7d e $f. set x.}
5ce0: 20 7b 72 65 61 64 79 20 64 6f 6e 65 7d 0a 0a 74 {ready done}..t
5cf0: 65 73 74 20 74 6c 73 49 4f 2d 34 2e 31 20 7b 73 est tlsIO-4.1 {s
5d00: 65 72 76 65 72 20 77 69 74 68 20 73 65 76 65 72 erver with sever
5d10: 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b 73 6f 63 al clients} {soc
5d20: 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 20 20 ket stdio} {.
5d30: 20 23 20 68 61 76 65 20 73 65 65 6e 20 69 6e 74 # have seen int
5d40: 65 72 6d 69 74 74 65 6e 74 20 68 61 6e 67 73 20 ermittent hangs
5d50: 6f 6e 20 57 69 6e 64 6f 77 73 0a 20 20 20 20 72 on Windows. r
5d60: 65 6d 6f 76 65 46 69 6c 65 20 73 63 72 69 70 74 emoveFile script
5d70: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
5d80: 20 73 63 72 69 70 74 20 77 5d 0a 20 20 20 20 70 script w]. p
5d90: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
5da0: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
5db0: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
5dc0: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
5dd0: 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 20 quire tls..gets
5de0: 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 20 stdin. }.
5df0: 70 75 74 73 20 24 66 20 22 73 65 74 20 73 20 5c puts $f "set s \
5e00: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 [tls::socket -ce
5e10: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
5e20: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
5e30: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
5e40: 65 6e 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 entKey 127.0.0.1
5e50: 20 38 38 32 38 20 5c 5d 22 0a 20 20 20 20 70 75 8828 \]". pu
5e60: 74 73 20 24 66 20 7b 0a 09 66 63 6f 6e 66 69 67 ts $f {..fconfig
5e70: 75 72 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e ure $s -bufferin
5e80: 67 20 6c 69 6e 65 0a 09 66 6f 72 20 7b 73 65 74 g line..for {set
5e90: 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 7d i 0} {$i < 100}
5ea0: 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 20 20 20 {incr i} {..
5eb0: 20 70 75 74 73 20 24 73 20 68 65 6c 6c 6f 0a 09 puts $s hello..
5ec0: 20 20 20 20 67 65 74 73 20 24 73 0a 09 7d 0a 09 gets $s..}..
5ed0: 63 6c 6f 73 65 20 24 73 0a 09 70 75 74 73 20 62 close $s..puts b
5ee0: 79 65 0a 09 67 65 74 73 20 73 74 64 69 6e 0a 20 ye..gets stdin.
5ef0: 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 }. close $
5f00: 66 0a 20 20 20 20 73 65 74 20 70 31 20 5b 6f 70 f. set p1 [op
5f10: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
5f20: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
5f30: 63 72 69 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 cript]" r+].
5f40: 66 63 6f 6e 66 69 67 75 72 65 20 24 70 31 20 2d fconfigure $p1 -
5f50: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
5f60: 20 20 20 73 65 74 20 70 32 20 5b 6f 70 65 6e 20 set p2 [open
5f70: 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 "|[list $::tclte
5f80: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
5f90: 70 74 5d 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f pt]" r+]. fco
5fa0: 6e 66 69 67 75 72 65 20 24 70 32 20 2d 62 75 66 nfigure $p2 -buf
5fb0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 fering line.
5fc0: 73 65 74 20 70 33 20 5b 6f 70 65 6e 20 22 7c 5b set p3 [open "|[
5fd0: 6c 69 73 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a list $::tcltest:
5fe0: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 5d :tcltest script]
5ff0: 22 20 72 2b 5d 0a 20 20 20 20 66 63 6f 6e 66 69 " r+]. fconfi
6000: 67 75 72 65 20 24 70 33 20 2d 62 75 66 66 65 72 gure $p3 -buffer
6010: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 70 72 6f ing line. pro
6020: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
6030: 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 20 24 {..fconfigure $
6040: 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e s -buffering lin
6050: 65 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 e..fileevent $s
6060: 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 65 readable [list e
6070: 63 68 6f 20 24 73 5d 0a 20 20 20 20 7d 0a 20 20 cho $s]. }.
6080: 20 20 70 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 proc echo {s}
6090: 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 {..global x.
60a0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
60b0: 24 73 5d 0a 20 20 20 20 20 20 20 20 69 66 20 7b $s]. if {
60c0: 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 20 20 20 20 [eof $s]} {.
60d0: 20 20 20 20 20 20 20 20 63 6c 6f 73 65 20 24 73 close $s
60e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74 . set
60f0: 20 78 20 64 6f 6e 65 0a 20 20 20 20 20 20 20 20 x done.
6100: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
6110: 20 20 20 20 20 70 75 74 73 20 24 73 20 24 6c 0a puts $s $l.
6120: 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a }. }.
6130: 20 20 20 20 73 65 74 20 74 31 20 5b 61 66 74 65 set t1 [afte
6140: 72 20 33 30 30 30 30 20 22 73 65 74 20 78 20 74 r 30000 "set x t
6150: 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 20 20 73 imed_out"]. s
6160: 65 74 20 74 32 20 5b 61 66 74 65 72 20 33 31 30 et t2 [after 310
6170: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
6180: 6f 75 74 22 5d 0a 20 20 20 20 73 65 74 20 74 33 out"]. set t3
6190: 20 5b 61 66 74 65 72 20 33 32 30 30 30 20 22 73 [after 32000 "s
61a0: 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d et x timed_out"]
61b0: 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a . set s [tls:
61c0: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
61d0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
61e0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
61f0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
6200: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
6210: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
6220: 38 32 38 5d 0a 20 20 20 20 70 75 74 73 20 24 70 828]. puts $p
6230: 31 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 73 20 1 open. puts
6240: 24 70 32 20 6f 70 65 6e 0a 20 20 20 20 70 75 74 $p2 open. put
6250: 73 20 24 70 33 20 6f 70 65 6e 0a 20 20 20 20 76 s $p3 open. v
6260: 77 61 69 74 20 78 0a 20 20 20 20 76 77 61 69 74 wait x. vwait
6270: 20 78 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 x. vwait x.
6280: 20 20 20 61 66 74 65 72 20 63 61 6e 63 65 6c 20 after cancel
6290: 24 74 31 0a 20 20 20 20 61 66 74 65 72 20 63 61 $t1. after ca
62a0: 6e 63 65 6c 20 24 74 32 0a 20 20 20 20 61 66 74 ncel $t2. aft
62b0: 65 72 20 63 61 6e 63 65 6c 20 24 74 33 0a 20 20 er cancel $t3.
62c0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 73 close $s. s
62d0: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
62e0: 65 6e 64 20 6c 20 5b 6c 69 73 74 20 70 31 20 5b end l [list p1 [
62f0: 67 65 74 73 20 24 70 31 5d 20 24 78 5d 0a 20 20 gets $p1] $x].
6300: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 6c 69 73 lappend l [lis
6310: 74 20 70 32 20 5b 67 65 74 73 20 24 70 32 5d 20 t p2 [gets $p2]
6320: 24 78 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 $x]. lappend
6330: 6c 20 5b 6c 69 73 74 20 70 33 20 5b 67 65 74 73 l [list p3 [gets
6340: 20 24 70 33 5d 20 24 78 5d 0a 20 20 20 20 70 75 $p3] $x]. pu
6350: 74 73 20 24 70 31 20 62 79 65 0a 20 20 20 20 70 ts $p1 bye. p
6360: 75 74 73 20 24 70 32 20 62 79 65 0a 20 20 20 20 uts $p2 bye.
6370: 70 75 74 73 20 24 70 33 20 62 79 65 0a 20 20 20 puts $p3 bye.
6380: 20 63 6c 6f 73 65 20 24 70 31 0a 20 20 20 20 63 close $p1. c
6390: 6c 6f 73 65 20 24 70 32 0a 20 20 20 20 63 6c 6f lose $p2. clo
63a0: 73 65 20 24 70 33 0a 20 20 20 20 73 65 74 20 6c se $p3. set l
63b0: 0a 7d 20 7b 7b 70 31 20 62 79 65 20 64 6f 6e 65 .} {{p1 bye done
63c0: 7d 20 7b 70 32 20 62 79 65 20 64 6f 6e 65 7d 20 } {p2 bye done}
63d0: 7b 70 33 20 62 79 65 20 64 6f 6e 65 7d 7d 0a 0a {p3 bye done}}..
63e0: 74 65 73 74 20 74 6c 73 49 4f 2d 34 2e 32 20 7b test tlsIO-4.2 {
63f0: 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f 62 6c byte order probl
6400: 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 ems, socket numb
6410: 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 6f 63 ers, htons} {soc
6420: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 78 ket} {. set x
6430: 20 6f 6b 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 ok. if {[cat
6440: 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 ch {tls::socket
6450: 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 30 78 33 -server dodo 0x3
6460: 30 30 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 000} msg]} {..se
6470: 74 20 78 20 24 6d 73 67 0a 20 20 20 20 7d 20 65 t x $msg. } e
6480: 6c 73 65 20 7b 0a 09 63 6c 6f 73 65 20 24 6d 73 lse {..close $ms
6490: 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 g. }. set
64a0: 78 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 x.} ok..test tls
64b0: 49 4f 2d 35 2e 31 20 7b 62 79 74 65 20 6f 72 64 IO-5.1 {byte ord
64c0: 65 72 20 70 72 6f 62 6c 65 6d 73 2c 20 73 6f 63 er problems, soc
64d0: 6b 65 74 20 6e 75 6d 62 65 72 73 2c 20 68 74 6f ket numbers, hto
64e0: 6e 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 75 ns} \..{socket u
64f0: 6e 69 78 4f 6e 6c 79 20 6e 6f 74 52 6f 6f 74 7d nixOnly notRoot}
6500: 20 7b 0a 20 20 20 20 73 65 74 20 78 20 7b 63 6f {. set x {co
6510: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
6520: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 20 et: not owner}.
6530: 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 7b if {![catch {
6540: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
6550: 76 65 72 20 64 6f 64 6f 20 30 78 31 7d 20 6d 73 ver dodo 0x1} ms
6560: 67 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 g]} {. se
6570: 74 20 78 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c t x {htons probl
6580: 65 6d 2c 20 73 68 6f 75 6c 64 20 62 65 20 64 69 em, should be di
6590: 73 61 6c 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f sallowed, are yo
65a0: 75 20 72 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f u running as SU?
65b0: 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 }..close $msg.
65c0: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
65d0: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
65e0: 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 ocket: not owner
65f0: 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 35 2e 32 }.test tlsIO-5.2
6600: 20 7b 62 79 74 65 20 6f 72 64 65 72 20 70 72 6f {byte order pro
6610: 62 6c 65 6d 73 2c 20 73 6f 63 6b 65 74 20 6e 75 blems, socket nu
6620: 6d 62 65 72 73 2c 20 68 74 6f 6e 73 7d 20 7b 73 mbers, htons} {s
6630: 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 ocket} {. set
6640: 20 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 x {couldn't ope
6650: 6e 20 73 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e n socket: port n
6660: 75 6d 62 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a umber too high}.
6670: 20 20 20 20 69 66 20 7b 21 5b 63 61 74 63 68 20 if {![catch
6680: 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 {tls::socket -se
6690: 72 76 65 72 20 64 6f 64 6f 20 30 78 31 30 30 30 rver dodo 0x1000
66a0: 30 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 0} msg]} {..set
66b0: 78 20 7b 70 6f 72 74 20 72 65 73 6f 6c 75 74 69 x {port resoluti
66c0: 6f 6e 20 70 72 6f 62 6c 65 6d 2c 20 73 68 6f 75 on problem, shou
66d0: 6c 64 20 62 65 20 64 69 73 61 6c 6c 6f 77 65 64 ld be disallowed
66e0: 7d 0a 09 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 }..close $msg.
66f0: 20 20 7d 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 }. set x.}
6700: 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 {couldn't open s
6710: 6f 63 6b 65 74 3a 20 70 6f 72 74 20 6e 75 6d 62 ocket: port numb
6720: 65 72 20 74 6f 6f 20 68 69 67 68 7d 0a 74 65 73 er too high}.tes
6730: 74 20 74 6c 73 49 4f 2d 35 2e 33 20 7b 62 79 74 t tlsIO-5.3 {byt
6740: 65 20 6f 72 64 65 72 20 70 72 6f 62 6c 65 6d 73 e order problems
6750: 2c 20 73 6f 63 6b 65 74 20 6e 75 6d 62 65 72 73 , socket numbers
6760: 2c 20 68 74 6f 6e 73 7d 20 5c 0a 09 7b 73 6f 63 , htons} \..{soc
6770: 6b 65 74 20 75 6e 69 78 4f 6e 6c 79 20 6e 6f 74 ket unixOnly not
6780: 52 6f 6f 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 Root} {. set
6790: 78 20 7b 63 6f 75 6c 64 6e 27 74 20 6f 70 65 6e x {couldn't open
67a0: 20 73 6f 63 6b 65 74 3a 20 6e 6f 74 20 6f 77 6e socket: not own
67b0: 65 72 7d 0a 20 20 20 20 69 66 20 7b 21 5b 63 61 er}. if {![ca
67c0: 74 63 68 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 tch {tls::socket
67d0: 20 2d 73 65 72 76 65 72 20 64 6f 64 6f 20 32 31 -server dodo 21
67e0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
67f0: 20 7b 68 74 6f 6e 73 20 70 72 6f 62 6c 65 6d 2c {htons problem,
6800: 20 73 68 6f 75 6c 64 20 62 65 20 64 69 73 61 6c should be disal
6810: 6c 6f 77 65 64 2c 20 61 72 65 20 79 6f 75 20 72 lowed, are you r
6820: 75 6e 6e 69 6e 67 20 61 73 20 53 55 3f 7d 0a 09 unning as SU?}..
6830: 63 6c 6f 73 65 20 24 6d 73 67 0a 20 20 20 20 7d close $msg. }
6840: 0a 20 20 20 20 73 65 74 20 78 0a 7d 20 7b 63 6f . set x.} {co
6850: 75 6c 64 6e 27 74 20 6f 70 65 6e 20 73 6f 63 6b uldn't open sock
6860: 65 74 3a 20 6e 6f 74 20 6f 77 6e 65 72 7d 0a 0a et: not owner}..
6870: 74 65 73 74 20 74 6c 73 49 4f 2d 36 2e 31 20 7b test tlsIO-6.1 {
6880: 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 accept callback
6890: 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 73 error} {socket s
68a0: 74 64 69 6f 7d 20 7b 0a 20 20 20 20 23 20 54 68 tdio} {. # Th
68b0: 65 72 65 20 69 73 20 61 20 64 65 62 75 67 20 61 ere is a debug a
68c0: 73 73 65 72 74 69 6f 6e 20 6f 6e 20 57 69 6e 64 ssertion on Wind
68d0: 6f 77 73 2f 53 53 4c 20 74 68 61 74 20 63 61 75 ows/SSL that cau
68e0: 73 65 73 20 61 20 63 72 61 73 68 20 77 68 65 6e ses a crash when
68f0: 20 74 68 65 0a 20 20 20 20 23 20 63 65 72 74 69 the. # certi
6900: 66 69 63 61 74 65 20 69 73 6e 27 74 20 73 70 65 ficate isn't spe
6910: 63 69 66 69 65 64 2e 0a 20 20 20 20 72 65 6d 6f cified.. remo
6920: 76 65 46 69 6c 65 20 73 63 72 69 70 74 0a 20 20 veFile script.
6930: 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 63 set f [open sc
6940: 72 69 70 74 20 77 5d 0a 20 20 20 20 70 75 74 73 ript w]. puts
6950: 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 61 75 $f [list set au
6960: 74 6f 5f 70 61 74 68 20 24 61 75 74 6f 5f 70 61 to_path $auto_pa
6970: 74 68 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 th]. puts $f
6980: 7b 0a 20 20 20 20 09 70 61 63 6b 61 67 65 20 72 {. .package r
6990: 65 71 75 69 72 65 20 74 6c 73 0a 09 67 65 74 73 equire tls..gets
69a0: 20 73 74 64 69 6e 0a 20 20 20 20 7d 0a 20 20 20 stdin. }.
69b0: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 74 puts $f [list t
69c0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 ls::socket -cafi
69d0: 6c 65 20 24 63 61 43 65 72 74 20 31 32 37 2e 30 le $caCert 127.0
69e0: 2e 30 2e 31 20 38 38 34 38 5d 0a 20 20 20 20 63 .0.1 8848]. c
69f0: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
6a00: 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 74 20 f [open "|[list
6a10: 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 $::tcltest::tclt
6a20: 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 2b 5d est script]" r+]
6a30: 0a 20 20 20 20 70 72 6f 63 20 62 67 65 72 72 6f . proc bgerro
6a40: 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f 62 61 6c r args {..global
6a50: 20 78 0a 09 73 65 74 20 78 20 24 61 72 67 73 0a x..set x $args.
6a60: 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 }. proc a
6a70: 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 65 ccept {s a p} {e
6a80: 78 70 72 20 31 30 20 2f 20 30 7d 0a 20 20 20 20 xpr 10 / 0}.
6a90: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
6aa0: 65 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 et -server accep
6ab0: 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 t \.. -certfi
6ac0: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
6ad0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
6ae0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
6af0: 65 79 20 38 38 34 38 5d 0a 20 20 20 20 70 75 74 ey 8848]. put
6b00: 73 20 24 66 20 68 65 6c 6c 6f 0a 20 20 20 20 63 s $f hello. c
6b10: 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 74 20 lose $f. set
6b20: 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 timer [after 100
6b30: 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 5f 00 "set x timed_
6b40: 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 out"]. vwait
6b50: 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 x. after canc
6b60: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 6c el $timer. cl
6b70: 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 6d ose $s. renam
6b80: 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 20 e bgerror {}.
6b90: 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 64 set x.} {{divid
6ba0: 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 73 e by zero}}..tes
6bb0: 74 20 74 6c 73 49 4f 2d 37 2e 31 20 7b 74 65 73 t tlsIO-7.1 {tes
6bc0: 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 70 65 63 ting socket spec
6bd0: 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d 20 7b 73 ific options} {s
6be0: 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 7b 0a 20 ocket stdio} {.
6bf0: 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 20 73 63 removeFile sc
6c00: 72 69 70 74 0a 20 20 20 20 73 65 74 20 66 20 5b ript. set f [
6c10: 6f 70 65 6e 20 73 63 72 69 70 74 20 77 5d 0a 20 open script w].
6c20: 20 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 puts $f [list
6c30: 20 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 set auto_path $
6c40: 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 auto_path]. p
6c50: 75 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 uts $f {..packag
6c60: 65 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 e require tls.
6c70: 20 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 }. puts $f
6c80: 5b 6c 69 73 74 20 74 6c 73 3a 3a 73 6f 63 6b 65 [list tls::socke
6c90: 74 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 t -server accept
6ca0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
6cb0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
6cc0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
6cd0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
6ce0: 79 20 38 38 32 30 5d 0a 20 20 20 20 70 75 74 73 y 8820]. puts
6cf0: 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 65 $f {..proc acce
6d00: 70 74 20 61 72 67 73 20 7b 0a 09 20 20 20 20 67 pt args {.. g
6d10: 6c 6f 62 61 6c 20 78 0a 09 20 20 20 20 73 65 74 lobal x.. set
6d20: 20 78 20 64 6f 6e 65 0a 09 7d 0a 09 70 75 74 73 x done..}..puts
6d30: 20 72 65 61 64 79 0a 09 73 65 74 20 74 69 6d 65 ready..set time
6d40: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
6d50: 73 65 74 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 set x timed_out"
6d60: 5d 0a 09 76 77 61 69 74 20 78 0a 09 61 66 74 65 ]..vwait x..afte
6d70: 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a r cancel $timer.
6d80: 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 }. close
6d90: 24 66 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 $f. set f [op
6da0: 65 6e 20 22 7c 5b 6c 69 73 74 20 24 3a 3a 74 63 en "|[list $::tc
6db0: 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 ltest::tcltest s
6dc0: 63 72 69 70 74 5d 22 20 72 5d 0a 20 20 20 20 67 cript]" r]. g
6dd0: 65 74 73 20 24 66 0a 20 20 20 20 73 65 74 20 73 ets $f. set s
6de0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
6df0: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
6e00: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
6e10: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
6e20: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
6e30: 0a 09 20 20 20 20 31 32 37 2e 30 2e 30 2e 31 20 .. 127.0.0.1
6e40: 38 38 32 30 5d 0a 20 20 20 20 73 65 74 20 70 20 8820]. set p
6e50: 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d [fconfigure $s -
6e60: 70 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 63 6c peername]. cl
6e70: 6f 73 65 20 24 73 0a 20 20 20 20 63 6c 6f 73 65 ose $s. close
6e80: 20 24 66 0a 20 20 20 20 73 65 74 20 6c 20 22 22 $f. set l ""
6e90: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b . lappend l [
6ea0: 73 74 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 5b string compare [
6eb0: 6c 69 6e 64 65 78 20 24 70 20 30 5d 20 31 32 37 lindex $p 0] 127
6ec0: 2e 30 2e 30 2e 31 5d 0a 20 20 20 20 6c 61 70 70 .0.0.1]. lapp
6ed0: 65 6e 64 20 6c 20 5b 73 74 72 69 6e 67 20 63 6f end l [string co
6ee0: 6d 70 61 72 65 20 5b 6c 69 6e 64 65 78 20 24 70 mpare [lindex $p
6ef0: 20 32 5d 20 38 38 32 30 5d 0a 20 20 20 20 6c 61 2] 8820]. la
6f00: 70 70 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 ppend l [llength
6f10: 20 24 70 5d 0a 7d 20 7b 30 20 30 20 33 7d 0a 0a $p].} {0 0 3}..
6f20: 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 32 20 7b test tlsIO-7.2 {
6f30: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
6f40: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
6f50: 20 7b 73 6f 63 6b 65 74 20 73 74 64 69 6f 7d 20 {socket stdio}
6f60: 7b 0a 20 20 20 20 72 65 6d 6f 76 65 46 69 6c 65 {. removeFile
6f70: 20 73 63 72 69 70 74 0a 20 20 20 20 73 65 74 20 script. set
6f80: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 20 77 f [open script w
6f90: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
6fa0: 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 74 ist set auto_pat
6fb0: 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 20 h $auto_path].
6fc0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 63 puts $f {..pac
6fd0: 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c 73 kage require tls
6fe0: 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 20 . }. puts
6ff0: 24 66 20 22 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 $f "tls::socket
7000: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 2d -server accept -
7010: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
7020: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7030: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
7040: 65 72 76 65 72 4b 65 79 20 38 38 32 31 22 0a 20 erverKey 8821".
7050: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 72 puts $f {..pr
7060: 6f 63 20 61 63 63 65 70 74 20 61 72 67 73 20 7b oc accept args {
7070: 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 09 .. global x..
7080: 20 20 20 20 73 65 74 20 78 20 64 6f 6e 65 0a 09 set x done..
7090: 7d 0a 09 70 75 74 73 20 72 65 61 64 79 0a 09 73 }..puts ready..s
70a0: 65 74 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 et timer [after
70b0: 31 30 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 10000 "set x tim
70c0: 65 64 5f 6f 75 74 22 5d 0a 09 76 77 61 69 74 20 ed_out"]..vwait
70d0: 78 0a 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 x..after cancel
70e0: 24 74 69 6d 65 72 0a 20 20 20 20 7d 0a 20 20 20 $timer. }.
70f0: 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 close $f. se
7100: 74 20 66 20 5b 6f 70 65 6e 20 22 7c 5b 6c 69 73 t f [open "|[lis
7110: 74 20 24 3a 3a 74 63 6c 74 65 73 74 3a 3a 74 63 t $::tcltest::tc
7120: 6c 74 65 73 74 20 73 63 72 69 70 74 5d 22 20 72 ltest script]" r
7130: 5d 0a 20 20 20 20 67 65 74 73 20 24 66 0a 20 20 ]. gets $f.
7140: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
7150: 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 72 cket \.. -cer
7160: 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 72 tfile $clientCer
7170: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
7180: 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 t -keyfile $clie
7190: 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 32 37 ntKey \.. 127
71a0: 2e 30 2e 30 2e 31 20 38 38 32 31 5d 0a 20 20 20 .0.0.1 8821].
71b0: 20 73 65 74 20 70 20 5b 66 63 6f 6e 66 69 67 75 set p [fconfigu
71c0: 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d re $s -sockname]
71d0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 . close $s.
71e0: 20 20 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 close $f. s
71f0: 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 70 70 et l "". lapp
7200: 65 6e 64 20 6c 20 5b 6c 6c 65 6e 67 74 68 20 24 end l [llength $
7210: 70 5d 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 6c p]. lappend l
7220: 20 5b 6c 69 6e 64 65 78 20 24 70 20 30 5d 0a 20 [lindex $p 0].
7230: 20 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 73 74 lappend l [st
7240: 72 69 6e 67 20 65 71 75 61 6c 20 5b 6c 69 6e 64 ring equal [lind
7250: 65 78 20 24 70 20 32 5d 20 38 38 32 31 5d 0a 7d ex $p 2] 8821].}
7260: 20 7b 33 20 31 32 37 2e 30 2e 30 2e 31 20 30 7d {3 127.0.0.1 0}
7270: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e 33 ..test tlsIO-7.3
7280: 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 {testing socket
7290: 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e specific option
72a0: 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 s} {socket} {.
72b0: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
72c0: 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 6c cket \..-certfil
72d0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
72e0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
72f0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
7300: 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 72 y \. .-server
7310: 20 61 63 63 65 70 74 20 38 38 32 32 5d 0a 20 20 accept 8822].
7320: 20 20 73 65 74 20 6c 20 5b 6c 6c 65 6e 67 74 68 set l [llength
7330: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 5d [fconfigure $s]
7340: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
7350: 20 20 20 75 70 64 61 74 65 0a 20 20 20 20 23 20 update. #
7360: 41 20 62 75 67 20 66 69 78 65 64 20 69 6e 20 66 A bug fixed in f
7370: 63 6f 6e 66 69 67 75 72 65 20 66 6f 72 20 38 2e configure for 8.
7380: 33 2e 34 2b 20 6d 61 6b 65 20 74 68 69 73 20 72 3.4+ make this r
7390: 65 74 75 72 6e 20 31 34 20 6e 6f 72 6d 61 6c 6c eturn 14 normall
73a0: 79 2c 0a 20 20 20 20 23 20 62 75 74 20 31 32 20 y,. # but 12
73b0: 69 6e 20 6f 6c 64 65 72 20 76 65 72 73 69 6f 6e in older version
73c0: 73 2e 0a 20 20 20 20 65 78 70 72 20 7b 24 6c 20 s.. expr {$l
73d0: 3e 3d 20 31 32 20 26 26 20 28 28 24 6c 20 25 20 >= 12 && (($l %
73e0: 32 29 20 3d 3d 20 30 29 7d 0a 7d 20 31 0a 0a 23 2) == 0)}.} 1..#
73f0: 20 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 bug report #581
7400: 32 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 2 fconfigure doe
7410: 73 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 sn't return valu
7420: 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 e for '-sockname
7430: 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e '..test tlsIO-7.
7440: 34 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 4 {testing socke
7450: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
7460: 6e 73 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 ns} {socket} {.
7470: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
7480: 6f 63 6b 65 74 20 5c 0a 09 2d 63 65 72 74 66 69 ocket \..-certfi
7490: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
74a0: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
74b0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
74c0: 65 79 20 5c 0a 20 20 20 20 09 2d 73 65 72 76 65 ey \. .-serve
74d0: 72 20 61 63 63 65 70 74 20 38 38 32 33 5d 0a 20 r accept 8823].
74e0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
74f0: 73 20 61 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c s a p} {..global
7500: 20 78 0a 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 x..set x [fconf
7510: 69 67 75 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 igure $s -sockna
7520: 6d 65 5d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 me]..close $s.
7530: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 31 20 5b }. set s1 [
7540: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 2d tls::socket \..-
7550: 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 certfile $client
7560: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
7570: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 Cert -keyfile $c
7580: 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 20 09 lientKey \. .
7590: 6c 6f 63 61 6c 68 6f 73 74 20 38 38 32 33 5d 0a localhost 8823].
75a0: 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b 61 set timer [a
75b0: 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 20 fter 10000 "set
75c0: 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 20 x timed_out"].
75d0: 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 66 vwait x. af
75e0: 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 ter cancel $time
75f0: 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 r. close $s.
7600: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
7610: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
7620: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
7630: 24 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 $x 2] [llength $
7640: 78 5d 0a 7d 20 7b 38 38 32 33 20 33 7d 0a 0a 23 x].} {8823 3}..#
7650: 20 62 75 67 20 72 65 70 6f 72 74 20 23 35 38 31 bug report #581
7660: 32 20 66 63 6f 6e 66 69 67 75 72 65 20 64 6f 65 2 fconfigure doe
7670: 73 6e 27 74 20 72 65 74 75 72 6e 20 76 61 6c 75 sn't return valu
7680: 65 20 66 6f 72 20 27 2d 73 6f 63 6b 6e 61 6d 65 e for '-sockname
7690: 27 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 37 2e '..test tlsIO-7.
76a0: 35 20 7b 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 5 {testing socke
76b0: 74 20 73 70 65 63 69 66 69 63 20 6f 70 74 69 6f t specific optio
76c0: 6e 73 7d 20 7b 73 6f 63 6b 65 74 20 75 6e 69 78 ns} {socket unix
76d0: 4f 72 50 63 7d 20 7b 0a 20 20 20 20 73 65 74 20 OrPc} {. set
76e0: 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c s [tls::socket \
76f0: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
7700: 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 $serverCert -caf
7710: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
7720: 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 file $serverKey
7730: 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 \.. -server a
7740: 63 63 65 70 74 20 38 38 32 39 5d 0a 20 20 20 20 ccept 8829].
7750: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 proc accept {s a
7760: 20 70 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a p} {..global x.
7770: 09 73 65 74 20 78 20 5b 66 63 6f 6e 66 69 67 75 .set x [fconfigu
7780: 72 65 20 24 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d re $s -sockname]
7790: 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d ..close $s. }
77a0: 0a 20 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 . set s1 [tls
77b0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
77c0: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
77d0: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
77e0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
77f0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
7800: 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 39 5d 127.0.0.1 8829]
7810: 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 5b . set timer [
7820: 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 74 after 10000 "set
7830: 20 78 20 74 69 6d 65 64 5f 6f 75 74 22 5d 0a 20 x timed_out"].
7840: 20 20 20 76 77 61 69 74 20 78 0a 20 20 20 20 61 vwait x. a
7850: 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 6d fter cancel $tim
7860: 65 72 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a er. close $s.
7870: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
7880: 20 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c set l "". l
7890: 61 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 append l [lindex
78a0: 20 24 78 20 30 5d 20 5b 6c 69 6e 64 65 78 20 24 $x 0] [lindex $
78b0: 78 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 78 x 2] [llength $x
78c0: 5d 0a 7d 20 7b 31 32 37 2e 30 2e 30 2e 31 20 38 ].} {127.0.0.1 8
78d0: 38 32 39 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 829 3}..test tls
78e0: 49 4f 2d 38 2e 31 20 7b 74 65 73 74 69 6e 67 20 IO-8.1 {testing
78f0: 2d 61 73 79 6e 63 20 66 6c 61 67 20 6f 6e 20 73 -async flag on s
7900: 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 74 7d ockets} {socket}
7910: 20 7b 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 54 {. # NOTE: T
7920: 68 69 73 20 74 65 73 74 20 6d 61 79 20 66 61 69 his test may fai
7930: 6c 20 6f 6e 20 73 6f 6d 65 20 53 6f 6c 61 72 69 l on some Solari
7940: 73 20 32 2e 34 20 73 79 73 74 65 6d 73 2e 0a 20 s 2.4 systems..
7950: 20 20 20 23 20 53 65 65 20 6e 6f 74 65 73 20 69 # See notes i
7960: 6e 20 54 63 6c 27 73 20 73 6f 63 6b 65 74 2e 74 n Tcl's socket.t
7970: 65 73 74 2e 0a 20 20 20 20 73 65 74 20 73 20 5b est.. set s [
7980: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
7990: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
79a0: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
79b0: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
79c0: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
79d0: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
79e0: 70 74 20 38 38 33 30 5d 0a 20 20 20 20 70 72 6f pt 8830]. pro
79f0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
7a00: 20 7b 0a 09 67 6c 6f 62 61 6c 20 78 0a 09 23 20 {..global x..#
7a10: 77 68 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e when doing an in
7a20: 2d 70 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f -process client/
7a30: 73 65 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 server test, bot
7a40: 68 20 73 69 64 65 73 20 6e 65 65 64 0a 09 23 20 h sides need..#
7a50: 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b 69 to be non-blocki
7a60: 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 68 ng for the TLS h
7a70: 61 6e 64 73 68 61 6b 65 2e 20 20 41 6c 73 6f 20 andshake. Also
7a80: 6d 61 6b 65 20 73 75 72 65 0a 09 23 20 74 6f 20 make sure..# to
7a90: 72 65 74 75 72 6e 20 74 68 65 20 63 68 61 6e 6e return the chann
7aa0: 65 6c 20 74 6f 20 6c 69 6e 65 20 62 75 66 66 65 el to line buffe
7ab0: 72 69 6e 67 20 6d 6f 64 65 2e 0a 09 66 63 6f 6e ring mode...fcon
7ac0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
7ad0: 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 ing 0 -buffering
7ae0: 20 6c 69 6e 65 0a 09 70 75 74 73 20 24 73 20 62 line..puts $s b
7af0: 79 65 0a 09 23 20 4f 6e 6c 79 20 4f 70 65 6e 53 ye..# Only OpenS
7b00: 53 4c 20 30 2e 39 2e 35 61 20 6f 6e 20 57 69 6e SL 0.9.5a on Win
7b10: 64 6f 77 73 20 73 65 65 6d 73 20 74 6f 20 6e 65 dows seems to ne
7b20: 65 64 20 74 68 65 20 61 66 74 65 72 20 28 64 65 ed the after (de
7b30: 6c 61 79 65 64 29 0a 09 23 20 63 6c 6f 73 65 2c layed)..# close,
7b40: 20 62 75 74 20 69 74 20 77 6f 72 6b 73 20 6a 75 but it works ju
7b50: 73 74 20 74 68 65 20 73 61 6d 65 20 66 6f 72 20 st the same for
7b60: 61 6c 6c 20 6f 74 68 65 72 73 2e 20 2d 68 6f 62 all others. -hob
7b70: 62 73 0a 09 61 66 74 65 72 20 35 30 30 20 63 6c bs..after 500 cl
7b80: 6f 73 65 20 24 73 0a 09 73 65 74 20 78 20 64 6f ose $s..set x do
7b90: 6e 65 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 ne. }. set
7ba0: 20 73 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 s1 [tls::socket
7bb0: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
7bc0: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
7bd0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
7be0: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
7bf0: 79 20 5c 0a 09 20 20 20 20 2d 61 73 79 6e 63 20 y \.. -async
7c00: 6c 6f 63 61 6c 68 6f 73 74 20 38 38 33 30 5d 0a localhost 8830].
7c10: 20 20 20 20 23 20 77 68 65 6e 20 64 6f 69 6e 67 # when doing
7c20: 20 61 6e 20 69 6e 2d 70 72 6f 63 65 73 73 20 63 an in-process c
7c30: 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 74 65 73 lient/server tes
7c40: 74 2c 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 t, both sides ne
7c50: 65 64 0a 20 20 20 20 23 20 74 6f 20 62 65 20 6e ed. # to be n
7c60: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 66 6f 72 20 on-blocking for
7c70: 74 68 65 20 54 4c 53 20 68 61 6e 64 73 68 61 6b the TLS handshak
7c80: 65 20 20 41 6c 73 6f 20 6d 61 6b 65 20 73 75 72 e Also make sur
7c90: 65 20 74 6f 0a 20 20 20 20 23 20 72 65 74 75 72 e to. # retur
7ca0: 6e 20 74 68 65 20 63 68 61 6e 6e 65 6c 20 74 6f n the channel to
7cb0: 20 6c 69 6e 65 20 62 75 66 66 65 72 69 6e 67 20 line buffering
7cc0: 6d 6f 64 65 20 28 54 4c 53 20 73 65 74 73 20 69 mode (TLS sets i
7cd0: 74 20 74 6f 20 27 6e 6f 6e 65 27 29 2e 0a 20 20 t to 'none')..
7ce0: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 31 fconfigure $s1
7cf0: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 20 2d 62 75 -blocking 0 -bu
7d00: 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 ffering line.
7d10: 20 76 77 61 69 74 20 78 0a 20 20 20 20 23 20 54 vwait x. # T
7d20: 4c 53 20 68 61 6e 64 73 68 61 6b 69 6e 67 20 6e LS handshaking n
7d30: 65 65 64 73 20 6f 6e 65 20 62 79 74 65 20 66 72 eeds one byte fr
7d40: 6f 6d 20 74 68 65 20 63 6c 69 65 6e 74 2e 2e 2e om the client...
7d50: 0a 20 20 20 20 70 75 74 73 20 24 73 31 20 61 0a . puts $s1 a.
7d60: 20 20 20 20 23 20 6e 65 65 64 20 75 70 64 61 74 # need updat
7d70: 65 20 74 6f 20 63 6f 6d 70 6c 65 74 65 20 54 4c e to complete TL
7d80: 53 20 68 61 6e 64 73 68 61 6b 65 20 69 6e 2d 70 S handshake in-p
7d90: 72 6f 63 65 73 73 0a 20 20 20 20 75 70 64 61 74 rocess. updat
7da0: 65 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 e. fconfigure
7db0: 20 24 73 31 20 2d 62 6c 6f 63 6b 69 6e 67 20 31 $s1 -blocking 1
7dc0: 0a 20 20 20 20 73 65 74 20 7a 20 5b 67 65 74 73 . set z [gets
7dd0: 20 24 73 31 5d 0a 20 20 20 20 63 6c 6f 73 65 20 $s1]. close
7de0: 24 73 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 $s. close $s1
7df0: 0a 20 20 20 20 73 65 74 20 7a 0a 7d 20 62 79 65 . set z.} bye
7e00: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 39 2e 31 ..test tlsIO-9.1
7e10: 20 7b 74 65 73 74 69 6e 67 20 73 70 75 72 69 6f {testing spurio
7e20: 75 73 20 65 76 65 6e 74 73 7d 20 7b 73 6f 63 6b us events} {sock
7e30: 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 et} {. set le
7e40: 6e 20 30 0a 20 20 20 20 73 65 74 20 73 70 75 72 n 0. set spur
7e50: 69 6f 75 73 20 30 0a 20 20 20 20 73 65 74 20 64 ious 0. set d
7e60: 6f 6e 65 20 30 0a 20 20 20 20 70 72 6f 63 20 72 one 0. proc r
7e70: 65 61 64 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a eadlittle {s} {.
7e80: 09 67 6c 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 .global spurious
7e90: 20 64 6f 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c done len..set l
7ea0: 20 5b 72 65 61 64 20 24 73 20 31 5d 0a 09 69 66 [read $s 1]..if
7eb0: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
7ec0: 20 24 6c 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 $l] == 0} {..
7ed0: 20 20 69 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d if {![eof $s]}
7ee0: 20 7b 0a 09 09 69 6e 63 72 20 73 70 75 72 69 6f {...incr spurio
7ef0: 75 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 7b us.. } else {
7f00: 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 ...close $s...se
7f10: 74 20 64 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a t done 1.. }.
7f20: 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 .} else {.. i
7f30: 6e 63 72 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 ncr len [string
7f40: 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 length $l]..}.
7f50: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 }. proc acc
7f60: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 ept {s a p} {..f
7f70: 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 6c configure $s -bl
7f80: 6f 63 6b 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 ocking 0..fileev
7f90: 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 ent $s readable
7fa0: 5b 6c 69 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 [list do_handsha
7fb0: 6b 65 20 24 73 20 72 65 61 64 61 62 6c 65 20 72 ke $s readable r
7fc0: 65 61 64 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 eadlittle \...-b
7fd0: 75 66 66 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 uffering none].
7fe0: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b }. set s [
7ff0: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
8000: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 -certfile $se
8010: 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 rverCert -cafile
8020: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
8030: 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 e $serverKey \..
8040: 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 -server acce
8050: 70 74 20 38 38 33 31 5d 0a 20 20 20 20 73 65 74 pt 8831]. set
8060: 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 c [tls::socket
8070: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
8080: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
8090: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
80a0: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
80b0: 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 \.. localhos
80c0: 74 20 38 38 33 31 5d 0a 20 20 20 20 23 20 54 68 t 8831]. # Th
80d0: 69 73 20 64 69 66 66 65 72 73 20 66 72 6f 6d 20 is differs from
80e0: 73 6f 63 6b 65 74 2d 39 2e 31 20 69 6e 20 74 68 socket-9.1 in th
80f0: 61 74 20 62 6f 74 68 20 73 69 64 65 73 20 6e 65 at both sides ne
8100: 65 64 20 74 6f 20 62 65 0a 20 20 20 20 23 20 6e ed to be. # n
8110: 6f 6e 2d 62 6c 6f 63 6b 69 6e 67 20 62 65 63 61 on-blocking beca
8120: 75 73 65 20 6f 66 20 54 4c 53 27 20 72 65 71 75 use of TLS' requ
8130: 69 72 65 64 20 68 61 6e 64 73 68 61 6b 65 0a 20 ired handshake.
8140: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 63 fconfigure $c
8150: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 -blocking 0.
8160: 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 puts -nonewline
8170: 20 24 63 20 30 31 32 33 34 35 36 37 38 39 30 31 $c 012345678901
8180: 32 33 34 35 36 37 38 39 30 31 32 33 34 35 36 37 2345678901234567
8190: 38 39 30 31 32 33 34 35 36 37 38 39 30 31 32 33 8901234567890123
81a0: 34 35 36 37 38 39 0a 20 20 20 20 63 6c 6f 73 65 456789. close
81b0: 20 24 63 0a 20 20 20 20 73 65 74 20 74 69 6d 65 $c. set time
81c0: 72 20 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 r [after 10000 "
81d0: 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f set done timed_o
81e0: 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 ut"]. vwait d
81f0: 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 one. after ca
8200: 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 ncel $timer.
8210: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 6c 69 73 close $s. lis
8220: 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c 65 6e t $spurious $len
8230: 0a 7d 20 7b 30 20 35 30 7d 0a 0a 74 65 73 74 20 .} {0 50}..test
8240: 74 6c 73 49 4f 2d 39 2e 32 20 7b 74 65 73 74 69 tlsIO-9.2 {testi
8250: 6e 67 20 61 73 79 6e 63 20 77 72 69 74 65 2c 20 ng async write,
8260: 66 69 6c 65 65 76 65 6e 74 73 2c 20 66 6c 75 73 fileevents, flus
8270: 68 20 6f 6e 20 63 6c 6f 73 65 7d 20 7b 73 6f 63 h on close} {soc
8280: 6b 65 74 7d 20 7b 0a 20 20 20 20 73 65 74 20 66 ket} {. set f
8290: 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72 69 6e irstblock [strin
82a0: 67 20 72 65 70 65 61 74 20 61 20 33 31 5d 0a 20 g repeat a 31].
82b0: 20 20 20 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f set secondblo
82c0: 63 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 ck [string repea
82d0: 74 20 62 20 36 35 35 33 35 5d 0a 20 20 20 20 70 t b 65535]. p
82e0: 72 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 roc accept {s a
82f0: 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 67 75 72 65 p} {..fconfigure
8300: 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a $s -blocking 0.
8310: 09 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 .fileevent $s re
8320: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f adable [list do_
8330: 68 61 6e 64 73 68 61 6b 65 20 24 73 20 72 65 61 handshake $s rea
8340: 64 61 62 6c 65 20 72 65 61 64 61 62 6c 65 20 5c dable readable \
8350: 0a 09 09 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ...-translation
8360: 6c 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 lf -buffersize 1
8370: 36 33 38 34 20 2d 62 75 66 66 65 72 69 6e 67 20 6384 -buffering
8380: 6c 69 6e 65 5d 0a 20 20 20 20 7d 0a 20 20 20 20 line]. }.
8390: 70 72 6f 63 20 72 65 61 64 61 62 6c 65 20 7b 73 proc readable {s
83a0: 7d 20 7b 0a 09 73 65 74 20 6c 20 5b 67 65 74 73 } {..set l [gets
83b0: 20 24 73 5d 0a 09 64 70 75 74 73 20 22 67 6f 74 $s]..dputs "got
83c0: 20 5c 22 5b 73 74 72 69 6e 67 20 72 65 70 6c 61 \"[string repla
83d0: 63 65 20 24 6c 20 31 30 20 65 6e 64 2d 33 20 2e ce $l 10 end-3 .
83e0: 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 ..]\" \...([stri
83f0: 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 29 20 66 ng length $l]) f
8400: 72 6f 6d 20 24 73 22 0a 09 66 69 6c 65 65 76 65 rom $s"..fileeve
8410: 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b nt $s readable {
8420: 7d 0a 09 61 66 74 65 72 20 31 30 30 30 20 72 65 }..after 1000 re
8430: 73 70 6f 6e 64 20 24 73 0a 20 20 20 20 7d 0a 20 spond $s. }.
8440: 20 20 20 70 72 6f 63 20 72 65 73 70 6f 6e 64 20 proc respond
8450: 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 66 69 {s} {..global fi
8460: 72 73 74 62 6c 6f 63 6b 0a 09 64 70 75 74 73 20 rstblock..dputs
8470: 22 73 65 6e 64 20 5c 22 5b 73 74 72 69 6e 67 20 "send \"[string
8480: 72 65 70 6c 61 63 65 20 24 66 69 72 73 74 62 6c replace $firstbl
8490: 6f 63 6b 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e ock 10 end-3 ...
84a0: 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 ]\" \...([string
84b0: 20 6c 65 6e 67 74 68 20 24 66 69 72 73 74 62 6c length $firstbl
84c0: 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 73 22 0a 09 ock]) down $s"..
84d0: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
84e0: 24 73 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 $s $firstblock..
84f0: 61 66 74 65 72 20 31 30 30 30 20 77 72 69 74 65 after 1000 write
8500: 64 61 74 61 20 24 73 0a 20 20 20 20 7d 0a 20 20 data $s. }.
8510: 20 20 70 72 6f 63 20 77 72 69 74 65 64 61 74 61 proc writedata
8520: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 73 {s} {..global s
8530: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 64 70 75 74 econdblock..dput
8540: 73 20 22 73 65 6e 64 20 5c 22 5b 73 74 72 69 6e s "send \"[strin
8550: 67 20 72 65 70 6c 61 63 65 20 24 73 65 63 6f 6e g replace $secon
8560: 64 62 6c 6f 63 6b 20 31 30 20 65 6e 64 2d 33 20 dblock 10 end-3
8570: 2e 2e 2e 5d 5c 22 20 5c 0a 09 09 28 5b 73 74 72 ...]\" \...([str
8580: 69 6e 67 20 6c 65 6e 67 74 68 20 24 73 65 63 6f ing length $seco
8590: 6e 64 62 6c 6f 63 6b 5d 29 20 64 6f 77 6e 20 24 ndblock]) down $
85a0: 73 22 0a 09 70 75 74 73 20 2d 6e 6f 6e 65 77 6c s"..puts -nonewl
85b0: 69 6e 65 20 24 73 20 24 73 65 63 6f 6e 64 62 6c ine $s $secondbl
85c0: 6f 63 6b 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 ock..close $s.
85d0: 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 }. set s [t
85e0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
85f0: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 -certfile $ser
8600: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
8610: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8620: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 $serverKey \..
8630: 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 -server accep
8640: 74 20 38 38 33 32 5d 0a 20 20 20 20 73 65 74 20 t 8832]. set
8650: 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c c [tls::socket \
8660: 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 .. -certfile
8670: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
8680: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
8690: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
86a0: 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 \.. localhost
86b0: 20 38 38 33 32 5d 0a 20 20 20 20 66 63 6f 6e 66 8832]. fconf
86c0: 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 igure $c -blocki
86d0: 6e 67 20 30 20 2d 74 72 61 6e 73 20 6c 66 20 2d ng 0 -trans lf -
86e0: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 buffering line.
86f0: 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 set count 0.
8700: 20 20 20 70 75 74 73 20 24 63 20 68 65 6c 6c 6f puts $c hello
8710: 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 69 74 . proc readit
8720: 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 {s} {..global c
8730: 6f 75 6e 74 20 64 6f 6e 65 0a 09 73 65 74 20 64 ount done..set d
8740: 61 74 61 20 5b 72 65 61 64 20 24 73 5d 0a 09 64 ata [read $s]..d
8750: 70 75 74 73 20 22 72 65 61 64 20 5c 22 5b 73 74 puts "read \"[st
8760: 72 69 6e 67 20 72 65 70 6c 61 63 65 20 24 64 61 ring replace $da
8770: 74 61 20 31 30 20 65 6e 64 2d 33 20 2e 2e 2e 5d ta 10 end-3 ...]
8780: 5c 22 20 5c 0a 09 09 28 5b 73 74 72 69 6e 67 20 \" \...([string
8790: 6c 65 6e 67 74 68 20 24 64 61 74 61 5d 29 20 66 length $data]) f
87a0: 72 6f 6d 20 24 73 22 0a 09 69 6e 63 72 20 63 6f rom $s"..incr co
87b0: 75 6e 74 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 unt [string leng
87c0: 74 68 20 24 64 61 74 61 5d 0a 09 69 66 20 7b 5b th $data]..if {[
87d0: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
87e0: 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 73 65 close $s.. se
87f0: 74 20 64 6f 6e 65 20 31 0a 09 7d 0a 20 20 20 20 t done 1..}.
8800: 7d 0a 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 }. fileevent
8810: 24 63 20 72 65 61 64 61 62 6c 65 20 22 72 65 61 $c readable "rea
8820: 64 69 74 20 24 63 22 0a 20 20 20 20 73 65 74 20 dit $c". set
8830: 64 6f 6e 65 20 30 0a 20 20 20 20 73 65 74 20 74 done 0. set t
8840: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
8850: 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 0 "set done time
8860: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
8870: 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 t done. after
8880: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
8890: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
88a0: 6c 69 73 74 20 24 63 6f 75 6e 74 20 24 64 6f 6e list $count $don
88b0: 65 0a 7d 20 7b 36 35 35 36 36 20 31 7d 0a 0a 74 e.} {65566 1}..t
88c0: 65 73 74 20 74 6c 73 49 4f 2d 39 2e 33 20 7b 74 est tlsIO-9.3 {t
88d0: 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 63 6b esting EOF stick
88e0: 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c 61 69 yness} {unexplai
88f0: 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 6b 65 nedFailure socke
8900: 74 7d 20 7b 0a 20 20 20 20 23 20 48 4f 42 42 53 t} {. # HOBBS
8910: 3a 20 6e 65 76 65 72 20 77 6f 72 6b 65 64 20 63 : never worked c
8920: 6f 72 72 65 63 74 6c 79 0a 20 20 20 20 70 72 6f orrectly. pro
8930: 63 20 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 7b c count_to_eof {
8940: 73 7d 20 7b 0a 09 67 6c 6f 62 61 6c 20 63 6f 75 s} {..global cou
8950: 6e 74 20 64 6f 6e 65 20 74 69 6d 65 72 0a 09 73 nt done timer..s
8960: 65 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 et l [gets $s]..
8970: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
8980: 09 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a . incr count.
8990: 09 20 20 20 20 69 66 20 7b 24 63 6f 75 6e 74 20 . if {$count
89a0: 3e 20 39 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 > 9} {...close $
89b0: 73 0a 09 09 73 65 74 20 64 6f 6e 65 20 74 72 75 s...set done tru
89c0: 65 0a 09 09 73 65 74 20 63 6f 75 6e 74 20 7b 65 e...set count {e
89d0: 6f 66 20 69 73 20 73 74 69 63 6b 79 7d 0a 09 09 of is sticky}...
89e0: 61 66 74 65 72 20 63 61 6e 63 65 6c 20 24 74 69 after cancel $ti
89f0: 6d 65 72 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 20 mer.. }..}.
8a00: 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 6d }. proc tim
8a10: 65 72 70 72 6f 63 20 7b 7d 20 7b 0a 09 67 6c 6f erproc {} {..glo
8a20: 62 61 6c 20 64 6f 6e 65 20 63 6f 75 6e 74 20 63 bal done count c
8a30: 0a 09 73 65 74 20 64 6f 6e 65 20 74 72 75 65 0a ..set done true.
8a40: 09 73 65 74 20 63 6f 75 6e 74 20 7b 74 69 6d 65 .set count {time
8a50: 72 20 77 65 6e 74 20 6f 66 66 2c 20 65 6f 66 20 r went off, eof
8a60: 69 73 20 6e 6f 74 20 73 74 69 63 6b 79 7d 0a 09 is not sticky}..
8a70: 63 6c 6f 73 65 20 24 63 0a 20 20 20 20 7d 0a 20 close $c. }.
8a80: 20 20 20 73 65 74 20 63 6f 75 6e 74 20 30 0a 20 set count 0.
8a90: 20 20 20 73 65 74 20 64 6f 6e 65 20 66 61 6c 73 set done fals
8aa0: 65 0a 20 20 20 20 70 72 6f 63 20 77 72 69 74 65 e. proc write
8ab0: 5f 74 68 65 6e 5f 63 6c 6f 73 65 20 7b 73 7d 20 _then_close {s}
8ac0: 7b 0a 09 70 75 74 73 20 24 73 20 62 79 65 0a 09 {..puts $s bye..
8ad0: 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 7d 0a 20 close $s. }.
8ae0: 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b proc accept {
8af0: 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e 66 69 s a p} {..fconfi
8b00: 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e gure $s -blockin
8b10: 67 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c g 0 -buffering l
8b20: 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e ine -translation
8b30: 20 6c 66 0a 09 66 69 6c 65 65 76 65 6e 74 20 24 lf..fileevent $
8b40: 73 20 77 72 69 74 61 62 6c 65 20 5b 6c 69 73 74 s writable [list
8b50: 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 24 73 do_handshake $s
8b60: 20 77 72 69 74 61 62 6c 65 20 77 72 69 74 65 5f writable write_
8b70: 74 68 65 6e 5f 63 6c 6f 73 65 20 5c 0a 09 09 2d then_close \...-
8b80: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
8b90: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 66 5d 0a translation lf].
8ba0: 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 20 }. set s
8bb0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 [tls::socket \..
8bc0: 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 73 -certfile $s
8bd0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
8be0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
8bf0: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
8c00: 09 20 20 20 20 2d 73 65 72 76 65 72 20 61 63 63 . -server acc
8c10: 65 70 74 20 38 38 33 33 5d 0a 20 20 20 20 73 65 ept 8833]. se
8c20: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
8c30: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
8c40: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
8c50: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
8c60: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
8c70: 79 20 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f y \.. localho
8c80: 73 74 20 38 38 33 33 5d 0a 20 20 20 20 66 63 6f st 8833]. fco
8c90: 6e 66 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 nfigure $c -bloc
8ca0: 6b 69 6e 67 20 30 20 2d 62 75 66 66 65 72 69 6e king 0 -bufferin
8cb0: 67 20 6c 69 6e 65 20 2d 74 72 61 6e 73 6c 61 74 g line -translat
8cc0: 69 6f 6e 20 6c 66 0a 20 20 20 20 66 69 6c 65 65 ion lf. filee
8cd0: 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c 65 vent $c readable
8ce0: 20 22 63 6f 75 6e 74 5f 74 6f 5f 65 6f 66 20 24 "count_to_eof $
8cf0: 63 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 c". set timer
8d00: 20 5b 61 66 74 65 72 20 32 30 30 30 20 74 69 6d [after 2000 tim
8d10: 65 72 70 72 6f 63 5d 0a 20 20 20 20 76 77 61 69 erproc]. vwai
8d20: 74 20 64 6f 6e 65 0a 20 20 20 20 63 6c 6f 73 65 t done. close
8d30: 20 24 73 0a 20 20 20 20 73 65 74 20 63 6f 75 6e $s. set coun
8d40: 74 0a 7d 20 7b 65 6f 66 20 69 73 20 73 74 69 63 t.} {eof is stic
8d50: 6b 79 7d 0a 0a 72 65 6d 6f 76 65 46 69 6c 65 20 ky}..removeFile
8d60: 73 63 72 69 70 74 0a 0a 74 65 73 74 20 74 6c 73 script..test tls
8d70: 49 4f 2d 31 30 2e 31 20 7b 74 65 73 74 69 6e 67 IO-10.1 {testing
8d80: 20 73 6f 63 6b 65 74 20 61 63 63 65 70 74 20 63 socket accept c
8d90: 61 6c 6c 62 61 63 6b 20 65 72 72 6f 72 20 68 61 allback error ha
8da0: 6e 64 6c 69 6e 67 7d 20 7b 73 6f 63 6b 65 74 7d ndling} {socket}
8db0: 20 7b 0a 20 20 20 20 73 65 74 20 67 6f 74 65 72 {. set goter
8dc0: 72 6f 72 20 30 0a 20 20 20 20 70 72 6f 63 20 62 ror 0. proc b
8dd0: 67 65 72 72 6f 72 20 61 72 67 73 20 7b 67 6c 6f gerror args {glo
8de0: 62 61 6c 20 67 6f 74 65 72 72 6f 72 3b 20 73 65 bal goterror; se
8df0: 74 20 67 6f 74 65 72 72 6f 72 20 31 7d 0a 20 20 t goterror 1}.
8e00: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
8e10: 63 6b 65 74 20 2d 63 61 66 69 6c 65 20 24 63 61 cket -cafile $ca
8e20: 43 65 72 74 20 2d 73 65 72 76 65 72 20 61 63 63 Cert -server acc
8e30: 65 70 74 20 38 38 39 38 5d 0a 20 20 20 20 70 72 ept 8898]. pr
8e40: 6f 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 oc accept {s a p
8e50: 7d 20 7b 63 6c 6f 73 65 20 24 73 3b 20 65 72 72 } {close $s; err
8e60: 6f 72 7d 0a 20 20 20 20 73 65 74 20 63 20 5b 74 or}. set c [t
8e70: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 63 61 66 69 ls::socket -cafi
8e80: 6c 65 20 24 63 61 43 65 72 74 20 31 32 37 2e 30 le $caCert 127.0
8e90: 2e 30 2e 31 20 38 38 39 38 5d 0a 20 20 20 20 76 .0.1 8898]. v
8ea0: 77 61 69 74 20 67 6f 74 65 72 72 6f 72 0a 20 20 wait goterror.
8eb0: 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 63 close $s. c
8ec0: 6c 6f 73 65 20 24 63 0a 20 20 20 20 73 65 74 20 lose $c. set
8ed0: 67 6f 74 65 72 72 6f 72 0a 7d 20 31 0a 0a 74 65 goterror.} 1..te
8ee0: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 20 7b 74 st tlsIO-11.1 {t
8ef0: 63 70 20 63 6f 6e 6e 65 63 74 69 6f 6e 7d 20 7b cp connection} {
8f00: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
8f10: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
8f20: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
8f30: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
8f40: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
8f50: 65 74 39 5f 31 5f 74 65 73 74 5f 73 65 72 76 65 et9_1_test_serve
8f60: 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d r [tls::socket -
8f70: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a server accept \.
8f80: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
8f90: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
8fa0: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
8fb0: 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 33 34 $serverKey 8834
8fc0: 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 20 7b ]..proc accept {
8fd0: 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 74 6c s a p} {.. tl
8fe0: 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 0a s::handshake $s.
8ff0: 09 20 20 20 20 70 75 74 73 20 24 73 20 64 6f 6e . puts $s don
9000: 65 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a e.. close $s.
9010: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
9020: 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s [tls::socket
9030: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9040: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9050: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9060: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9070: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9080: 65 72 76 65 72 49 50 20 38 38 33 34 5d 0a 20 20 erverIP 8834].
9090: 20 20 73 65 74 20 72 20 5b 67 65 74 73 20 24 73 set r [gets $s
90a0: 5d 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 ]. close $s.
90b0: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
90c0: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 39 5f 31 close $socket9_1
90d0: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
90e0: 20 20 73 65 74 20 72 0a 7d 20 64 6f 6e 65 0a 0a set r.} done..
90f0: 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 32 20 test tlsIO-11.2
9100: 7b 63 6c 69 65 6e 74 20 73 70 65 63 69 66 69 65 {client specifie
9110: 73 20 69 74 73 20 70 6f 72 74 7d 20 7b 73 6f 63 s its port} {soc
9120: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9130: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9140: 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69 if {[info exi
9150: 73 74 73 20 70 6f 72 74 5d 7d 20 7b 0a 09 69 6e sts port]} {..in
9160: 63 72 20 70 6f 72 74 0a 20 20 20 20 7d 20 65 6c cr port. } el
9170: 73 65 20 7b 0a 09 73 65 74 20 70 6f 72 74 20 5b se {..set port [
9180: 65 78 70 72 20 7b 24 74 6c 73 53 65 72 76 65 72 expr {$tlsServer
9190: 50 6f 72 74 20 2b 20 5b 70 69 64 5d 25 31 30 32 Port + [pid]%102
91a0: 34 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 4}]. }. se
91b0: 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 ndCertValues.
91c0: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 sendCommand {..
91d0: 73 65 74 20 73 6f 63 6b 65 74 39 5f 32 5f 74 65 set socket9_2_te
91e0: 73 74 5f 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a st_server [tls::
91f0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
9200: 63 63 65 70 74 20 5c 0a 09 09 2d 63 65 72 74 66 ccept \...-certf
9210: 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 ile $serverCert
9220: 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 -cafile $caCert
9230: 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 -keyfile $server
9240: 4b 65 79 20 38 38 33 35 5d 0a 09 70 72 6f 63 20 Key 8835]..proc
9250: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
9260: 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 .. tls::hands
9270: 68 61 6b 65 20 24 73 0a 09 20 20 20 20 70 75 74 hake $s.. put
9280: 73 20 24 73 20 24 70 0a 09 20 20 20 20 63 6c 6f s $s $p.. clo
9290: 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 7d 0a 20 se $s..}. }.
92a0: 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 set s [tls::s
92b0: 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 65 ocket \.. -ce
92c0: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
92d0: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
92e0: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
92f0: 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 2d 6d entKey \.. -m
9300: 79 70 6f 72 74 20 24 70 6f 72 74 20 24 72 65 6d yport $port $rem
9310: 6f 74 65 53 65 72 76 65 72 49 50 20 38 38 33 35 oteServerIP 8835
9320: 5d 0a 20 20 20 20 73 65 74 20 72 20 5b 67 65 74 ]. set r [get
9330: 73 20 24 73 5d 0a 20 20 20 20 63 6c 6f 73 65 20 s $s]. close
9340: 24 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d 6d 61 $s. sendComma
9350: 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 6b 65 nd {close $socke
9360: 74 39 5f 32 5f 74 65 73 74 5f 73 65 72 76 65 72 t9_2_test_server
9370: 7d 0a 20 20 20 20 69 66 20 7b 24 72 20 3d 3d 20 }. if {$r ==
9380: 24 70 6f 72 74 7d 20 7b 0a 09 73 65 74 20 72 65 $port} {..set re
9390: 73 75 6c 74 20 6f 6b 0a 20 20 20 20 7d 20 65 6c sult ok. } el
93a0: 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 se {..set result
93b0: 20 62 72 6f 6b 65 6e 0a 20 20 20 20 7d 0a 20 20 broken. }.
93c0: 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 6f set result.} o
93d0: 6b 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 k..test tlsIO-11
93e0: 2e 33 20 7b 74 72 79 69 6e 67 20 74 6f 20 63 6f .3 {trying to co
93f0: 6e 6e 65 63 74 2c 20 6e 6f 20 73 65 72 76 65 72 nnect, no server
9400: 7d 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 } {socket doTest
9410: 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 sWithRemoteServe
9420: 72 7d 20 7b 0a 20 20 20 20 73 65 74 20 73 74 61 r} {. set sta
9430: 74 75 73 20 6f 6b 0a 20 20 20 20 69 66 20 7b 21 tus ok. if {!
9440: 5b 63 61 74 63 68 20 7b 73 65 74 20 73 20 5b 74 [catch {set s [t
9450: 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 ls::socket \..
9460: 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 -certfile $cli
9470: 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 entCert -cafile
9480: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
9490: 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 $clientKey \..
94a0: 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 $remoteServer
94b0: 49 70 20 38 38 33 36 5d 7d 5d 7d 20 7b 0a 09 69 Ip 8836]}]} {..i
94c0: 66 20 7b 21 5b 63 61 74 63 68 20 7b 67 65 74 73 f {![catch {gets
94d0: 20 24 73 7d 5d 7d 20 7b 0a 09 20 20 20 20 73 65 $s}]} {.. se
94e0: 74 20 73 74 61 74 75 73 20 62 72 6f 6b 65 6e 0a t status broken.
94f0: 09 7d 0a 09 63 6c 6f 73 65 20 24 73 0a 20 20 20 .}..close $s.
9500: 20 7d 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 }. set statu
9510: 73 0a 7d 20 6f 6b 0a 0a 74 65 73 74 20 74 6c 73 s.} ok..test tls
9520: 49 4f 2d 31 31 2e 34 20 7b 72 65 6d 6f 74 65 20 IO-11.4 {remote
9530: 65 63 68 6f 2c 20 6f 6e 65 20 6c 69 6e 65 7d 20 echo, one line}
9540: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
9550: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
9560: 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 {. sendCertV
9570: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
9580: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
9590: 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 ket10_6_test_ser
95a0: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
95b0: 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 \...-certfile $
95c0: 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 serverCert -cafi
95d0: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
95e0: 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c ile $serverKey \
95f0: 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 ...-server accep
9600: 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 t 8836]..proc ac
9610: 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 cept {s a p} {..
9620: 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 tls::handsha
9630: 6b 65 20 24 73 0a 09 20 20 20 20 66 69 6c 65 65 ke $s.. filee
9640: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
9650: 20 5b 6c 69 73 74 20 65 63 68 6f 20 24 73 5d 0a [list echo $s].
9660: 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 . fconfigure
9670: 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 $s -buffering li
9680: 6e 65 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 ne -translation
9690: 63 72 6c 66 0a 09 7d 0a 09 70 72 6f 63 20 65 63 crlf..}..proc ec
96a0: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 73 65 ho {s} {.. se
96b0: 74 20 6c 20 5b 67 65 74 73 20 24 73 5d 0a 09 20 t l [gets $s]..
96c0: 20 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d if {[eof $s]}
96d0: 20 7b 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 {...close $s..
96e0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 70 75 } else {...pu
96f0: 74 73 20 24 73 20 24 6c 0a 09 20 20 20 20 7d 0a ts $s $l.. }.
9700: 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 .}. }. set
9710: 20 66 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 f [tls::socket
9720: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
9730: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
9740: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
9750: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
9760: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
9770: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
9780: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 20 fconfigure $f
9790: 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c -translation crl
97a0: 66 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e f -buffering lin
97b0: 65 0a 20 20 20 20 70 75 74 73 20 24 66 20 68 65 e. puts $f he
97c0: 6c 6c 6f 0a 20 20 20 20 73 65 74 20 72 20 5b 67 llo. set r [g
97d0: 65 74 73 20 24 66 5d 0a 20 20 20 20 63 6c 6f 73 ets $f]. clos
97e0: 65 20 24 66 0a 20 20 20 20 73 65 6e 64 43 6f 6d e $f. sendCom
97f0: 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 24 73 6f 63 mand {close $soc
9800: 6b 65 74 31 30 5f 36 5f 74 65 73 74 5f 73 65 72 ket10_6_test_ser
9810: 76 65 72 7d 0a 20 20 20 20 73 65 74 20 72 0a 7d ver}. set r.}
9820: 20 68 65 6c 6c 6f 0a 0a 74 65 73 74 20 74 6c 73 hello..test tls
9830: 49 4f 2d 31 31 2e 35 20 7b 72 65 6d 6f 74 65 20 IO-11.5 {remote
9840: 65 63 68 6f 2c 20 35 30 20 6c 69 6e 65 73 7d 20 echo, 50 lines}
9850: 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 {socket doTestsW
9860: 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d ithRemoteServer}
9870: 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 {. sendCertV
9880: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
9890: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
98a0: 6b 65 74 31 30 5f 37 5f 74 65 73 74 5f 73 65 72 ket10_7_test_ser
98b0: 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 ver [tls::socket
98c0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
98d0: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
98e0: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
98f0: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9900: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 38 38 le $serverKey 88
9910: 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 74 36]..proc accept
9920: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 20 {s a p} {..
9930: 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 tls::handshake $
9940: 73 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 s.. fileevent
9950: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
9960: 73 74 20 65 63 68 6f 20 24 73 5d 0a 09 20 20 20 st echo $s]..
9970: 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d fconfigure $s -
9980: 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 20 2d buffering line -
9990: 74 72 61 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 translation crlf
99a0: 0a 09 7d 0a 09 70 72 6f 63 20 65 63 68 6f 20 7b ..}..proc echo {
99b0: 73 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 6c 20 s} {.. set l
99c0: 5b 67 65 74 73 20 24 73 5d 0a 09 20 20 20 20 69 [gets $s].. i
99d0: 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 f {[eof $s]} {..
99e0: 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 20 20 7d .close $s.. }
99f0: 20 65 6c 73 65 20 7b 0a 09 09 70 75 74 73 20 24 else {...puts $
9a00: 73 20 24 6c 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 s $l.. }..}.
9a10: 20 20 20 7d 0a 20 20 20 20 73 65 74 20 66 20 5b }. set f [
9a20: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 tls::socket \..
9a30: 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c -certfile $cl
9a40: 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 ientCert -cafile
9a50: 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c $caCert -keyfil
9a60: 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 e $clientKey \..
9a70: 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 76 65 $remoteServe
9a80: 72 49 50 20 38 38 33 36 5d 0a 20 20 20 20 66 63 rIP 8836]. fc
9a90: 6f 6e 66 69 67 75 72 65 20 24 66 20 2d 74 72 61 onfigure $f -tra
9aa0: 6e 73 6c 61 74 69 6f 6e 20 63 72 6c 66 20 2d 62 nslation crlf -b
9ab0: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
9ac0: 20 20 66 6f 72 20 7b 73 65 74 20 63 6e 74 20 30 for {set cnt 0
9ad0: 7d 20 7b 24 63 6e 74 20 3c 20 35 30 7d 20 7b 69 } {$cnt < 50} {i
9ae0: 6e 63 72 20 63 6e 74 7d 20 7b 0a 09 70 75 74 73 ncr cnt} {..puts
9af0: 20 24 66 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 $f "hello, $cnt
9b00: 22 0a 09 69 66 20 7b 5b 73 74 72 69 6e 67 20 63 "..if {[string c
9b10: 6f 6d 70 61 72 65 20 5b 67 65 74 73 20 24 66 5d ompare [gets $f]
9b20: 20 22 68 65 6c 6c 6f 2c 20 24 63 6e 74 22 5d 20 "hello, $cnt"]
9b30: 21 3d 20 30 7d 20 7b 0a 09 20 20 20 20 62 72 65 != 0} {.. bre
9b40: 61 6b 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 ak..}. }.
9b50: 63 6c 6f 73 65 20 24 66 0a 20 20 20 20 73 65 6e close $f. sen
9b60: 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 20 dCommand {close
9b70: 24 73 6f 63 6b 65 74 31 30 5f 37 5f 74 65 73 74 $socket10_7_test
9b80: 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 74 _server}. set
9b90: 20 63 6e 74 0a 7d 20 35 30 0a 0a 23 20 4d 61 63 cnt.} 50..# Mac
9ba0: 69 6e 74 6f 73 68 20 73 6f 63 6b 65 74 73 20 63 intosh sockets c
9bb0: 61 6e 20 68 61 76 65 20 6d 6f 72 65 20 74 68 61 an have more tha
9bc0: 6e 20 6f 6e 65 20 73 65 72 76 65 72 20 70 65 72 n one server per
9bd0: 20 70 6f 72 74 0a 69 66 20 7b 24 74 63 6c 5f 70 port.if {$tcl_p
9be0: 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d latform(platform
9bf0: 29 20 3d 3d 20 22 6d 61 63 69 6e 74 6f 73 68 22 ) == "macintosh"
9c00: 7d 20 7b 0a 20 20 20 20 73 65 74 20 63 6f 6e 66 } {. set conf
9c10: 6c 69 63 74 52 65 73 75 6c 74 20 7b 30 20 38 38 lictResult {0 88
9c20: 33 36 7d 0a 7d 20 65 6c 73 65 20 7b 0a 20 20 20 36}.} else {.
9c30: 20 73 65 74 20 63 6f 6e 66 6c 69 63 74 52 65 73 set conflictRes
9c40: 75 6c 74 20 7b 31 20 7b 63 6f 75 6c 64 6e 27 74 ult {1 {couldn't
9c50: 20 6f 70 65 6e 20 73 6f 63 6b 65 74 3a 20 61 64 open socket: ad
9c60: 64 72 65 73 73 20 61 6c 72 65 61 64 79 20 69 6e dress already in
9c70: 20 75 73 65 7d 7d 0a 7d 0a 0a 74 65 73 74 20 74 use}}.}..test t
9c80: 6c 73 49 4f 2d 31 31 2e 36 20 7b 73 6f 63 6b 65 lsIO-11.6 {socke
9c90: 74 20 63 6f 6e 66 6c 69 63 74 7d 20 7b 73 6f 63 t conflict} {soc
9ca0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
9cb0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
9cc0: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
9cd0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
9ce0: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
9cf0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
9d00: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
9d10: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
9d20: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
9d30: 33 36 5d 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 36]. if {[cat
9d40: 63 68 20 7b 73 65 74 20 73 32 20 5b 74 6c 73 3a ch {set s2 [tls:
9d50: 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d :socket \.. -
9d60: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
9d70: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
9d80: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
9d90: 65 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 erverKey \..
9da0: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
9db0: 38 33 36 5d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 836]} msg]} {..s
9dc0: 65 74 20 72 65 73 75 6c 74 20 5b 6c 69 73 74 20 et result [list
9dd0: 31 20 24 6d 73 67 5d 0a 20 20 20 20 7d 20 65 6c 1 $msg]. } el
9de0: 73 65 20 7b 0a 09 73 65 74 20 72 65 73 75 6c 74 se {..set result
9df0: 20 5b 6c 69 73 74 20 30 20 5b 6c 69 6e 64 65 78 [list 0 [lindex
9e00: 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 [fconfigure $s2
9e10: 20 2d 73 6f 63 6b 6e 61 6d 65 5d 20 32 5d 5d 0a -sockname] 2]].
9e20: 09 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 7d .close $s2. }
9e30: 0a 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 . close $s1.
9e40: 20 20 20 73 65 74 20 72 65 73 75 6c 74 0a 7d 20 set result.}
9e50: 24 63 6f 6e 66 6c 69 63 74 52 65 73 75 6c 74 0a $conflictResult.
9e60: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 37 .test tlsIO-11.7
9e70: 20 7b 73 65 72 76 65 72 20 77 69 74 68 20 73 65 {server with se
9e80: 76 65 72 61 6c 20 63 6c 69 65 6e 74 73 7d 20 7b veral clients} {
9e90: 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 57 69 socket doTestsWi
9ea0: 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 thRemoteServer}
9eb0: 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 61 {. sendCertVa
9ec0: 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f 6d lues. sendCom
9ed0: 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 6b mand {..set sock
9ee0: 65 74 31 30 5f 39 5f 74 65 73 74 5f 73 65 72 76 et10_9_test_serv
9ef0: 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 er [tls::socket
9f00: 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 \...-certfile $s
9f10: 65 72 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c erverCert -cafil
9f20: 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 e $caCert -keyfi
9f30: 6c 65 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a le $serverKey \.
9f40: 09 09 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 ..-server accept
9f50: 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 61 63 63 8836]..proc acc
9f60: 65 70 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 ept {s a p} {..
9f70: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 fconfigure $s
9f80: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
9f90: 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 20 .. fileevent
9fa0: 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 $s readable [lis
9fb0: 74 20 65 63 68 6f 20 24 73 5d 0a 09 7d 0a 09 70 t echo $s]..}..p
9fc0: 72 6f 63 20 65 63 68 6f 20 7b 73 7d 20 7b 0a 09 roc echo {s} {..
9fd0: 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 set l [gets
9fe0: 24 73 5d 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f $s].. if {[eo
9ff0: 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 f $s]} {...close
a000: 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 20 $s.. } else
a010: 7b 0a 09 09 70 75 74 73 20 24 73 20 24 6c 0a 09 {...puts $s $l..
a020: 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d 0a 20 }..}. }.
a030: 20 20 20 73 65 74 20 73 31 20 5b 74 6c 73 3a 3a set s1 [tls::
a040: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
a050: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
a060: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
a070: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
a080: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
a090: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
a0a0: 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 836]. fconfig
a0b0: 75 72 65 20 24 73 31 20 2d 62 75 66 66 65 72 69 ure $s1 -bufferi
a0c0: 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 74 20 ng line. set
a0d0: 73 32 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 s2 [tls::socket
a0e0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
a0f0: 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 $clientCert -ca
a100: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
a110: 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 yfile $clientKey
a120: 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 \.. $remoteS
a130: 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 20 erverIP 8836].
a140: 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 73 32 fconfigure $s2
a150: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
a160: 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 6c 73 . set s3 [tls
a170: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 ::socket \..
a180: 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e -certfile $clien
a190: 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 tCert -cafile $c
a1a0: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
a1b0: 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 clientKey \..
a1c0: 20 24 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 $remoteServerIP
a1d0: 20 38 38 33 36 5d 0a 20 20 20 20 66 63 6f 6e 66 8836]. fconf
a1e0: 69 67 75 72 65 20 24 73 33 20 2d 62 75 66 66 65 igure $s3 -buffe
a1f0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 66 6f ring line. fo
a200: 72 20 7b 73 65 74 20 69 20 30 7d 20 7b 24 69 20 r {set i 0} {$i
a210: 3c 20 31 30 30 7d 20 7b 69 6e 63 72 20 69 7d 20 < 100} {incr i}
a220: 7b 0a 09 70 75 74 73 20 24 73 31 20 68 65 6c 6c {..puts $s1 hell
a230: 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 31 0a o,tlsIO-11.7,s1.
a240: 09 67 65 74 73 20 24 73 31 0a 09 70 75 74 73 20 .gets $s1..puts
a250: 24 73 32 20 68 65 6c 6c 6f 2c 74 6c 73 49 4f 2d $s2 hello,tlsIO-
a260: 31 31 2e 37 2c 73 32 0a 09 67 65 74 73 20 24 73 11.7,s2..gets $s
a270: 32 0a 09 70 75 74 73 20 24 73 33 20 68 65 6c 6c 2..puts $s3 hell
a280: 6f 2c 74 6c 73 49 4f 2d 31 31 2e 37 2c 73 33 0a o,tlsIO-11.7,s3.
a290: 09 67 65 74 73 20 24 73 33 0a 20 20 20 20 7d 0a .gets $s3. }.
a2a0: 20 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 close $s1.
a2b0: 20 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 close $s2.
a2c0: 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 close $s3. se
a2d0: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
a2e0: 20 24 73 6f 63 6b 65 74 31 30 5f 39 5f 74 65 73 $socket10_9_tes
a2f0: 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 73 65 t_server}. se
a300: 74 20 69 0a 7d 20 31 30 30 0a 0a 74 65 73 74 20 t i.} 100..test
a310: 74 6c 73 49 4f 2d 31 31 2e 38 20 7b 63 6c 69 65 tlsIO-11.8 {clie
a320: 6e 74 20 77 69 74 68 20 73 65 76 65 72 61 6c 20 nt with several
a330: 73 65 72 76 65 72 73 7d 20 7b 73 6f 63 6b 65 74 servers} {socket
a340: 20 64 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f doTestsWithRemo
a350: 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 teServer} {.
a360: 73 65 6e 64 43 65 72 74 56 61 6c 75 65 73 0a 20 sendCertValues.
a370: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
a380: 0a 09 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 72 ..tls::init -cer
a390: 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 65 72 tfile $serverCer
a3a0: 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 72 t -cafile $caCer
a3b0: 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 72 76 t -keyfile $serv
a3c0: 65 72 4b 65 79 0a 09 73 65 74 20 73 31 20 5b 74 erKey..set s1 [t
a3d0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 ls::socket -serv
a3e0: 65 72 20 22 61 63 63 65 70 74 20 34 30 30 33 22 er "accept 4003"
a3f0: 20 34 30 30 33 5d 0a 09 73 65 74 20 73 32 20 5b 4003]..set s2 [
a400: 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 tls::socket -ser
a410: 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 34 ver "accept 4004
a420: 22 20 34 30 30 34 5d 0a 09 73 65 74 20 73 33 20 " 4004]..set s3
a430: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
a440: 72 76 65 72 20 22 61 63 63 65 70 74 20 34 30 30 rver "accept 400
a450: 35 22 20 34 30 30 35 5d 0a 09 70 72 6f 63 20 68 5" 4005]..proc h
a460: 61 6e 64 73 68 61 6b 65 20 7b 73 20 6d 70 7d 20 andshake {s mp}
a470: 7b 0a 09 20 20 20 20 69 66 20 7b 5b 65 6f 66 20 {.. if {[eof
a480: 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f 73 65 20 24 $s]} {...close $
a490: 73 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 20 s.. } elseif
a4a0: 7b 5b 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 61 {[catch {tls::ha
a4b0: 6e 64 73 68 61 6b 65 20 24 73 7d 20 72 65 73 75 ndshake $s} resu
a4c0: 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 6f 6d 65 20 lt]} {...# Some
a4d0: 65 72 72 6f 72 73 20 61 72 65 20 6e 6f 72 6d 61 errors are norma
a4e0: 6c 2e 0a 09 20 20 20 20 7d 20 65 6c 73 65 69 66 l... } elseif
a4f0: 20 7b 24 72 65 73 75 6c 74 20 3d 3d 20 31 7d 20 {$result == 1}
a500: 7b 0a 09 09 23 20 48 61 6e 64 73 68 61 6b 65 20 {...# Handshake
a510: 63 6f 6d 70 6c 65 74 65 0a 09 09 66 69 6c 65 65 complete...filee
a520: 76 65 6e 74 20 24 73 20 72 65 61 64 61 62 6c 65 vent $s readable
a530: 20 22 22 0a 09 09 70 75 74 73 20 24 73 20 24 6d ""...puts $s $m
a540: 70 0a 09 09 63 6c 6f 73 65 20 24 73 0a 09 20 20 p...close $s..
a550: 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 20 61 63 63 }..}..proc acc
a560: 65 70 74 20 7b 6d 70 20 73 20 61 20 70 7d 20 7b ept {mp s a p} {
a570: 0a 09 20 20 20 20 23 20 54 68 65 73 65 20 68 61 .. # These ha
a580: 76 65 20 74 6f 20 61 63 63 65 70 74 20 6e 6f 6e ve to accept non
a590: 2d 62 6c 6f 63 6b 69 6e 67 2c 20 62 65 63 61 75 -blocking, becau
a5a0: 73 65 20 74 68 65 20 68 61 6e 64 73 68 61 6b 69 se the handshaki
a5b0: 6e 67 0a 09 20 20 20 20 23 20 6f 72 64 65 72 20 ng.. # order
a5c0: 69 73 6e 27 74 20 64 65 74 65 72 6d 69 6e 69 73 isn't determinis
a5d0: 74 69 63 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 tic.. fconfig
a5e0: 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 ure $s -blocking
a5f0: 20 30 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 0 -buffering li
a600: 6e 65 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e ne.. fileeven
a610: 74 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c t $s readable [l
a620: 69 73 74 20 68 61 6e 64 73 68 61 6b 65 20 24 73 ist handshake $s
a630: 20 24 6d 70 5d 0a 09 7d 0a 20 20 20 20 7d 0a 20 $mp]..}. }.
a640: 20 20 20 74 6c 73 3a 3a 69 6e 69 74 20 2d 63 65 tls::init -ce
a650: 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 65 rtfile $clientCe
a660: 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 65 rt -cafile $caCe
a670: 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 rt -keyfile $cli
a680: 65 6e 74 4b 65 79 0a 20 20 20 20 73 65 74 20 73 entKey. set s
a690: 31 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 1 [tls::socket $
a6a0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 remoteServerIP 4
a6b0: 30 30 33 5d 0a 20 20 20 20 73 65 74 20 73 32 20 003]. set s2
a6c0: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 [tls::socket $re
a6d0: 6d 6f 74 65 53 65 72 76 65 72 49 50 20 34 30 30 moteServerIP 400
a6e0: 34 5d 0a 20 20 20 20 73 65 74 20 73 33 20 5b 74 4]. set s3 [t
a6f0: 6c 73 3a 3a 73 6f 63 6b 65 74 20 24 72 65 6d 6f ls::socket $remo
a700: 74 65 53 65 72 76 65 72 49 50 20 34 30 30 35 5d teServerIP 4005]
a710: 0a 20 20 20 20 73 65 74 20 6c 20 22 22 0a 20 20 . set l "".
a720: 20 20 6c 61 70 70 65 6e 64 20 6c 20 5b 67 65 74 lappend l [get
a730: 73 20 24 73 31 5d 20 5b 67 65 74 73 20 24 73 31 s $s1] [gets $s1
a740: 5d 20 5b 65 6f 66 20 24 73 31 5d 20 5b 67 65 74 ] [eof $s1] [get
a750: 73 20 24 73 32 5d 20 5b 67 65 74 73 20 24 73 32 s $s2] [gets $s2
a760: 5d 20 5b 65 6f 66 20 24 73 32 5d 20 5c 0a 09 5b ] [eof $s2] \..[
a770: 67 65 74 73 20 24 73 33 5d 20 5b 67 65 74 73 20 gets $s3] [gets
a780: 24 73 33 5d 20 5b 65 6f 66 20 24 73 33 5d 0a 20 $s3] [eof $s3].
a790: 20 20 20 63 6c 6f 73 65 20 24 73 31 0a 20 20 20 close $s1.
a7a0: 20 63 6c 6f 73 65 20 24 73 32 0a 20 20 20 20 63 close $s2. c
a7b0: 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 73 65 6e lose $s3. sen
a7c0: 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 63 6c 6f 73 dCommand {..clos
a7d0: 65 20 24 73 31 0a 09 63 6c 6f 73 65 20 24 73 32 e $s1..close $s2
a7e0: 0a 09 63 6c 6f 73 65 20 24 73 33 0a 20 20 20 20 ..close $s3.
a7f0: 7d 0a 20 20 20 20 73 65 74 20 6c 0a 7d 20 7b 34 }. set l.} {4
a800: 30 30 33 20 7b 7d 20 31 20 34 30 30 34 20 7b 7d 003 {} 1 4004 {}
a810: 20 31 20 34 30 30 35 20 7b 7d 20 31 7d 0a 0a 74 1 4005 {} 1}..t
a820: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 39 20 7b est tlsIO-11.9 {
a830: 61 63 63 65 70 74 20 63 61 6c 6c 62 61 63 6b 20 accept callback
a840: 65 72 72 6f 72 7d 20 7b 73 6f 63 6b 65 74 20 64 error} {socket d
a850: 6f 54 65 73 74 73 57 69 74 68 52 65 6d 6f 74 65 oTestsWithRemote
a860: 53 65 72 76 65 72 7d 20 7b 0a 20 20 20 20 73 65 Server} {. se
a870: 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t s [tls::socket
a880: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
a890: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
a8a0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
a8b0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
a8c0: 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 72 y \.. -server
a8d0: 20 61 63 63 65 70 74 20 38 38 33 36 5d 0a 20 20 accept 8836].
a8e0: 20 20 70 72 6f 63 20 61 63 63 65 70 74 20 7b 73 proc accept {s
a8f0: 20 61 20 70 7d 20 7b 65 78 70 72 20 31 30 20 2f a p} {expr 10 /
a900: 20 30 7d 0a 20 20 20 20 70 72 6f 63 20 62 67 65 0}. proc bge
a910: 72 72 6f 72 20 61 72 67 73 20 7b 0a 09 67 6c 6f rror args {..glo
a920: 62 61 6c 20 78 0a 09 73 65 74 20 78 20 24 61 72 bal x..set x $ar
a930: 67 73 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e gs. }. sen
a940: 64 43 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 dCertValues.
a950: 69 66 20 7b 5b 63 61 74 63 68 20 7b 73 65 6e 64 if {[catch {send
a960: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 20 20 20 20 73 Command {.. s
a970: 65 74 20 70 65 65 72 6e 61 6d 65 20 5b 66 63 6f et peername [fco
a980: 6e 66 69 67 75 72 65 20 24 63 61 6c 6c 65 72 53 nfigure $callerS
a990: 6f 63 6b 65 74 20 2d 70 65 65 72 6e 61 6d 65 5d ocket -peername]
a9a0: 0a 09 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 .. set s [tls
a9b0: 3a 3a 73 6f 63 6b 65 74 20 5c 0a 09 09 20 20 20 ::socket \...
a9c0: 20 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 -certfile $clie
a9d0: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
a9e0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
a9f0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 09 09 20 $clientKey \...
aa00: 20 20 20 5b 6c 69 6e 64 65 78 20 24 70 65 65 72 [lindex $peer
aa10: 6e 61 6d 65 20 30 5d 20 38 38 33 36 5d 0a 09 20 name 0] 8836]..
aa20: 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 20 close $s.
aa30: 09 20 7d 7d 20 6d 73 67 5d 7d 20 7b 0a 09 63 6c . }} msg]} {..cl
aa40: 6f 73 65 20 24 73 0a 09 65 72 72 6f 72 20 24 6d ose $s..error $m
aa50: 73 67 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 sg. }. set
aa60: 20 74 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 timer [after 10
aa70: 30 30 30 20 22 73 65 74 20 78 20 74 69 6d 65 64 000 "set x timed
aa80: 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 74 _out"]. vwait
aa90: 20 78 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e x. after can
aaa0: 63 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 63 cel $timer. c
aab0: 6c 6f 73 65 20 24 73 0a 20 20 20 20 72 65 6e 61 lose $s. rena
aac0: 6d 65 20 62 67 65 72 72 6f 72 20 7b 7d 0a 20 20 me bgerror {}.
aad0: 20 20 73 65 74 20 78 0a 7d 20 7b 7b 64 69 76 69 set x.} {{divi
aae0: 64 65 20 62 79 20 7a 65 72 6f 7d 7d 0a 0a 74 65 de by zero}}..te
aaf0: 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 30 20 7b st tlsIO-11.10 {
ab00: 74 65 73 74 69 6e 67 20 73 6f 63 6b 65 74 20 73 testing socket s
ab10: 70 65 63 69 66 69 63 20 6f 70 74 69 6f 6e 73 7d pecific options}
ab20: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
ab30: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
ab40: 7d 20 7b 0a 20 20 20 20 73 65 6e 64 43 65 72 74 } {. sendCert
ab50: 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 Values. sendC
ab60: 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f ommand {..set so
ab70: 63 6b 65 74 31 30 5f 31 32 5f 74 65 73 74 5f 73 cket10_12_test_s
ab80: 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 6b erver [tls::sock
ab90: 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c 65 et \...-certfile
aba0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
abb0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
abc0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
abd0: 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 63 \...-server acc
abe0: 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 20 ept 8836]..proc
abf0: 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 7b accept {s a p} {
ac00: 63 6c 6f 73 65 20 24 73 7d 0a 20 20 20 20 7d 0a close $s}. }.
ac10: 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a set s [tls::
ac20: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
ac30: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
ac40: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
ac50: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
ac60: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
ac70: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
ac80: 38 33 36 5d 0a 20 20 20 20 73 65 74 20 70 20 5b 836]. set p [
ac90: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 70 fconfigure $s -p
aca0: 65 65 72 6e 61 6d 65 5d 0a 20 20 20 20 73 65 74 eername]. set
acb0: 20 6e 20 5b 66 63 6f 6e 66 69 67 75 72 65 20 24 n [fconfigure $
acc0: 73 20 2d 73 6f 63 6b 6e 61 6d 65 5d 0a 20 20 20 s -sockname].
acd0: 20 73 65 74 20 6c 20 22 22 0a 20 20 20 20 6c 61 set l "". la
ace0: 70 70 65 6e 64 20 6c 20 5b 6c 69 6e 64 65 78 20 ppend l [lindex
acf0: 24 70 20 32 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 $p 2] [llength $
ad00: 70 5d 20 5b 6c 6c 65 6e 67 74 68 20 24 70 5d 0a p] [llength $p].
ad10: 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 20 20 20 close $s.
ad20: 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c sendCommand {cl
ad30: 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 32 ose $socket10_12
ad40: 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 _test_server}.
ad50: 20 20 73 65 74 20 6c 0a 7d 20 7b 38 38 33 36 20 set l.} {8836
ad60: 33 20 33 7d 0a 0a 74 65 73 74 20 74 6c 73 49 4f 3 3}..test tlsIO
ad70: 2d 31 31 2e 31 31 20 7b 74 65 73 74 69 6e 67 20 -11.11 {testing
ad80: 73 70 75 72 69 6f 75 73 20 65 76 65 6e 74 73 7d spurious events}
ad90: 20 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 74 73 {socket doTests
ada0: 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 65 72 WithRemoteServer
adb0: 7d 20 7b 0a 20 20 20 20 23 20 72 65 6d 6f 74 65 } {. # remote
adc0: 20 65 71 75 69 76 61 6c 65 6e 74 20 6f 66 20 39 equivalent of 9
add0: 2e 31 0a 20 20 20 20 73 65 6e 64 43 65 72 74 56 .1. sendCertV
ade0: 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 43 6f alues. sendCo
adf0: 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 6f 63 mmand {..set soc
ae00: 6b 65 74 5f 74 65 73 74 5f 73 65 72 76 65 72 20 ket_test_server
ae10: 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 [tls::socket -se
ae20: 72 76 65 72 20 61 63 63 65 70 74 20 5c 0a 09 09 rver accept \...
ae30: 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 -certfile $serve
ae40: 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 rCert -cafile $c
ae50: 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 aCert -keyfile $
ae60: 73 65 72 76 65 72 4b 65 79 20 38 38 33 36 5d 0a serverKey 8836].
ae70: 09 70 72 6f 63 20 68 61 6e 64 73 68 61 6b 65 20 .proc handshake
ae80: 7b 73 7d 20 7b 0a 09 20 20 20 20 69 66 20 7b 5b {s} {.. if {[
ae90: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 09 63 6c 6f eof $s]} {...clo
aea0: 73 65 20 24 73 0a 09 20 20 20 20 7d 20 65 6c 73 se $s.. } els
aeb0: 65 69 66 20 7b 5b 63 61 74 63 68 20 7b 74 6c 73 eif {[catch {tls
aec0: 3a 3a 68 61 6e 64 73 68 61 6b 65 20 24 73 7d 20 ::handshake $s}
aed0: 72 65 73 75 6c 74 5d 7d 20 7b 0a 09 09 23 20 53 result]} {...# S
aee0: 6f 6d 65 20 65 72 72 6f 72 73 20 61 72 65 20 6e ome errors are n
aef0: 6f 72 6d 61 6c 2e 0a 09 20 20 20 20 7d 20 65 6c ormal... } el
af00: 73 65 69 66 20 7b 24 72 65 73 75 6c 74 20 3d 3d seif {$result ==
af10: 20 31 7d 20 7b 0a 09 09 23 20 48 61 6e 64 73 68 1} {...# Handsh
af20: 61 6b 65 20 63 6f 6d 70 6c 65 74 65 0a 09 09 66 ake complete...f
af30: 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 69 74 ileevent $s writ
af40: 61 62 6c 65 20 22 22 0a 09 09 61 66 74 65 72 20 able ""...after
af50: 31 30 30 20 77 72 69 74 65 73 6f 6d 65 20 24 73 100 writesome $s
af60: 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 70 72 6f 63 .. }..}..proc
af70: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
af80: 7b 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 72 {.. fconfigur
af90: 65 20 24 73 20 2d 74 72 61 6e 73 6c 61 74 69 6f e $s -translatio
afa0: 6e 20 22 61 75 74 6f 20 6c 66 22 0a 09 20 20 20 n "auto lf"..
afb0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 77 72 fileevent $s wr
afc0: 69 74 61 62 6c 65 20 5b 6c 69 73 74 20 68 61 6e itable [list han
afd0: 64 73 68 61 6b 65 20 24 73 5d 0a 09 7d 0a 09 70 dshake $s]..}..p
afe0: 72 6f 63 20 77 72 69 74 65 73 6f 6d 65 20 7b 73 roc writesome {s
aff0: 7d 20 7b 0a 09 20 20 20 20 66 6f 72 20 7b 73 65 } {.. for {se
b000: 74 20 69 20 30 7d 20 7b 24 69 20 3c 20 31 30 30 t i 0} {$i < 100
b010: 7d 20 7b 69 6e 63 72 20 69 7d 20 7b 0a 09 09 70 } {incr i} {...p
b020: 75 74 73 20 24 73 20 22 6c 69 6e 65 20 24 69 20 uts $s "line $i
b030: 66 72 6f 6d 20 72 65 6d 6f 74 65 20 73 65 72 76 from remote serv
b040: 65 72 22 0a 09 20 20 20 20 7d 0a 09 20 20 20 20 er".. }..
b050: 63 6c 6f 73 65 20 24 73 0a 09 7d 0a 20 20 20 20 close $s..}.
b060: 7d 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 0a }. set len 0.
b070: 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 73 set spurious
b080: 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 20 0. set done
b090: 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 6c 0. proc readl
b0a0: 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c 6f ittle {s} {..glo
b0b0: 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f 6e bal spurious don
b0c0: 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 65 e len..set l [re
b0d0: 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b 73 ad $s 1]..if {[s
b0e0: 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d tring length $l]
b0f0: 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 66 == 0} {.. if
b100: 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 {![eof $s]} {..
b110: 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a 09 .incr spurious..
b120: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 63 } else {...c
b130: 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 6f lose $s...set do
b140: 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 65 ne 1.. }..} e
b150: 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 20 lse {.. incr
b160: 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e 67 len [string leng
b170: 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d 0a th $l]..}. }.
b180: 20 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a set c [tls::
b190: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
b1a0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
b1b0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
b1c0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
b1d0: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 24 ientKey \.. $
b1e0: 72 65 6d 6f 74 65 53 65 72 76 65 72 49 50 20 38 remoteServerIP 8
b1f0: 38 33 36 5d 0a 20 20 20 20 23 20 47 65 74 20 74 836]. # Get t
b200: 68 65 20 62 75 66 66 65 72 69 6e 67 20 63 6f 72 he buffering cor
b210: 72 65 63 74 65 64 0a 20 20 20 20 66 63 6f 6e 66 rected. fconf
b220: 69 67 75 72 65 20 24 63 20 2d 62 75 66 66 65 72 igure $c -buffer
b230: 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 23 20 50 ing line. # P
b240: 75 74 20 61 20 62 79 74 65 20 69 6e 74 6f 20 74 ut a byte into t
b250: 68 65 20 63 6c 69 65 6e 74 20 70 69 70 65 20 74 he client pipe t
b260: 6f 20 74 72 69 67 67 65 72 20 54 4c 53 20 68 61 o trigger TLS ha
b270: 6e 64 73 68 61 6b 69 6e 67 0a 20 20 20 20 70 75 ndshaking. pu
b280: 74 73 20 24 63 20 61 0a 20 20 20 20 66 69 6c 65 ts $c a. file
b290: 65 76 65 6e 74 20 24 63 20 72 65 61 64 61 62 6c event $c readabl
b2a0: 65 20 5b 6c 69 73 74 20 72 65 61 64 6c 69 74 74 e [list readlitt
b2b0: 6c 65 20 24 63 5d 0a 20 20 20 20 73 65 74 20 74 le $c]. set t
b2c0: 69 6d 65 72 20 5b 61 66 74 65 72 20 31 30 30 30 imer [after 1000
b2d0: 30 20 22 73 65 74 20 64 6f 6e 65 20 74 69 6d 65 0 "set done time
b2e0: 64 5f 6f 75 74 22 5d 0a 20 20 20 20 76 77 61 69 d_out"]. vwai
b2f0: 74 20 64 6f 6e 65 0a 20 20 20 20 61 66 74 65 72 t done. after
b300: 20 63 61 6e 63 65 6c 20 24 74 69 6d 65 72 0a 20 cancel $timer.
b310: 20 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b sendCommand {
b320: 63 6c 6f 73 65 20 24 73 6f 63 6b 65 74 5f 74 65 close $socket_te
b330: 73 74 5f 73 65 72 76 65 72 7d 0a 20 20 20 20 6c st_server}. l
b340: 69 73 74 20 24 73 70 75 72 69 6f 75 73 20 24 6c ist $spurious $l
b350: 65 6e 0a 7d 20 7b 30 20 32 36 39 30 7d 0a 0a 74 en.} {0 2690}..t
b360: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 32 20 est tlsIO-11.12
b370: 7b 74 65 73 74 69 6e 67 20 45 4f 46 20 73 74 69 {testing EOF sti
b380: 63 6b 79 6e 65 73 73 7d 20 7b 75 6e 65 78 70 6c ckyness} {unexpl
b390: 61 69 6e 65 64 46 61 69 6c 75 72 65 20 73 6f 63 ainedFailure soc
b3a0: 6b 65 74 20 64 6f 54 65 73 74 73 57 69 74 68 52 ket doTestsWithR
b3b0: 65 6d 6f 74 65 53 65 72 76 65 72 7d 20 7b 0a 20 emoteServer} {.
b3c0: 20 20 20 23 20 72 65 6d 6f 74 65 20 65 71 75 69 # remote equi
b3d0: 76 61 6c 65 6e 74 20 6f 66 20 39 2e 33 0a 20 20 valent of 9.3.
b3e0: 20 20 23 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 # HOBBS: never
b3f0: 20 77 6f 72 6b 65 64 20 63 6f 72 72 65 63 74 6c worked correctl
b400: 79 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 65 y. set counte
b410: 72 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 r 0. set done
b420: 20 30 0a 20 20 20 20 70 72 6f 63 20 63 6f 75 6e 0. proc coun
b430: 74 5f 75 70 20 7b 73 7d 20 7b 0a 09 67 6c 6f 62 t_up {s} {..glob
b440: 61 6c 20 63 6f 75 6e 74 65 72 20 64 6f 6e 65 20 al counter done
b450: 61 66 74 65 72 5f 69 64 0a 09 73 65 74 20 6c 20 after_id..set l
b460: 5b 67 65 74 73 20 24 73 5d 0a 09 69 66 20 7b 5b [gets $s]..if {[
b470: 65 6f 66 20 24 73 5d 7d 20 7b 0a 09 20 20 20 20 eof $s]} {..
b480: 69 6e 63 72 20 63 6f 75 6e 74 65 72 0a 09 20 20 incr counter..
b490: 20 20 69 66 20 7b 24 63 6f 75 6e 74 65 72 20 3e if {$counter >
b4a0: 20 39 7d 20 7b 0a 09 09 73 65 74 20 64 6f 6e 65 9} {...set done
b4b0: 20 7b 45 4f 46 20 69 73 20 73 74 69 63 6b 79 7d {EOF is sticky}
b4c0: 0a 09 09 61 66 74 65 72 20 63 61 6e 63 65 6c 20 ...after cancel
b4d0: 24 61 66 74 65 72 5f 69 64 0a 09 09 63 6c 6f 73 $after_id...clos
b4e0: 65 20 24 73 0a 09 20 20 20 20 7d 0a 09 7d 0a 20 e $s.. }..}.
b4f0: 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 74 69 }. proc ti
b500: 6d 65 64 5f 6f 75 74 20 7b 7d 20 7b 0a 09 67 6c med_out {} {..gl
b510: 6f 62 61 6c 20 63 20 64 6f 6e 65 0a 09 73 65 74 obal c done..set
b520: 20 64 6f 6e 65 20 7b 74 69 6d 65 64 5f 6f 75 74 done {timed_out
b530: 2c 20 45 4f 46 20 69 73 20 6e 6f 74 20 73 74 69 , EOF is not sti
b540: 63 6b 79 7d 0a 09 63 6c 6f 73 65 20 24 63 0a 20 cky}..close $c.
b550: 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 65 72 }. sendCer
b560: 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 6e 64 tValues. send
b570: 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 20 73 Command {..set s
b580: 6f 63 6b 65 74 31 30 5f 31 34 5f 74 65 73 74 5f ocket10_14_test_
b590: 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a 73 6f 63 server [tls::soc
b5a0: 6b 65 74 20 5c 0a 09 09 2d 63 65 72 74 66 69 6c ket \...-certfil
b5b0: 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 e $serverCert -c
b5c0: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
b5d0: 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 eyfile $serverKe
b5e0: 79 20 5c 0a 09 09 2d 73 65 72 76 65 72 20 61 63 y \...-server ac
b5f0: 63 65 70 74 20 38 38 33 36 5d 0a 09 70 72 6f 63 cept 8836]..proc
b600: 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d 20 accept {s a p}
b610: 7b 0a 09 20 20 20 20 74 6c 73 3a 3a 68 61 6e 64 {.. tls::hand
b620: 73 68 61 6b 65 20 24 73 0a 09 20 20 20 20 61 66 shake $s.. af
b630: 74 65 72 20 31 30 30 20 63 6c 6f 73 65 20 24 73 ter 100 close $s
b640: 0a 09 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 ..}. }. se
b650: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
b660: 20 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c \.. -certfil
b670: 65 20 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 e $clientCert -c
b680: 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b afile $caCert -k
b690: 65 79 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 eyfile $clientKe
b6a0: 79 20 5c 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 y \.. $remote
b6b0: 53 65 72 76 65 72 49 50 20 38 38 33 36 5d 0a 20 ServerIP 8836].
b6c0: 20 20 20 66 69 6c 65 65 76 65 6e 74 20 24 63 20 fileevent $c
b6d0: 72 65 61 64 61 62 6c 65 20 22 63 6f 75 6e 74 5f readable "count_
b6e0: 75 70 20 24 63 22 0a 20 20 20 20 73 65 74 20 61 up $c". set a
b6f0: 66 74 65 72 5f 69 64 20 5b 61 66 74 65 72 20 31 fter_id [after 1
b700: 30 30 30 20 74 69 6d 65 64 5f 6f 75 74 5d 0a 20 000 timed_out].
b710: 20 20 20 76 77 61 69 74 20 64 6f 6e 65 0a 20 20 vwait done.
b720: 20 20 73 65 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 sendCommand {c
b730: 6c 6f 73 65 20 24 73 6f 63 6b 65 74 31 30 5f 31 lose $socket10_1
b740: 34 5f 74 65 73 74 5f 73 65 72 76 65 72 7d 0a 20 4_test_server}.
b750: 20 20 20 73 65 74 20 64 6f 6e 65 0a 7d 20 7b 45 set done.} {E
b760: 4f 46 20 69 73 20 73 74 69 63 6b 79 7d 0a 0a 74 OF is sticky}..t
b770: 65 73 74 20 74 6c 73 49 4f 2d 31 31 2e 31 33 20 est tlsIO-11.13
b780: 7b 74 65 73 74 69 6e 67 20 61 73 79 6e 63 20 77 {testing async w
b790: 72 69 74 65 2c 20 61 73 79 6e 63 20 66 6c 75 73 rite, async flus
b7a0: 68 2c 20 61 73 79 6e 63 20 63 6c 6f 73 65 7d 20 h, async close}
b7b0: 5c 0a 09 7b 73 6f 63 6b 65 74 20 64 6f 54 65 73 \..{socket doTes
b7c0: 74 73 57 69 74 68 52 65 6d 6f 74 65 53 65 72 76 tsWithRemoteServ
b7d0: 65 72 7d 20 7b 0a 20 20 20 20 70 72 6f 63 20 72 er} {. proc r
b7e0: 65 61 64 69 74 20 7b 73 7d 20 7b 0a 09 67 6c 6f eadit {s} {..glo
b7f0: 62 61 6c 20 63 6f 75 6e 74 20 64 6f 6e 65 0a 09 bal count done..
b800: 73 65 74 20 6c 20 5b 72 65 61 64 20 24 73 5d 0a set l [read $s].
b810: 09 69 6e 63 72 20 63 6f 75 6e 74 20 5b 73 74 72 .incr count [str
b820: 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c 5d 0a 09 ing length $l]..
b830: 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a if {[eof $s]} {.
b840: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 20 . close $s..
b850: 20 20 20 73 65 74 20 64 6f 6e 65 20 31 0a 09 7d set done 1..}
b860: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 6e 64 43 . }. sendC
b870: 65 72 74 56 61 6c 75 65 73 0a 20 20 20 20 73 65 ertValues. se
b880: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 0a 09 73 65 74 ndCommand {..set
b890: 20 66 69 72 73 74 62 6c 6f 63 6b 20 5b 73 74 72 firstblock [str
b8a0: 69 6e 67 20 72 65 70 65 61 74 20 61 20 33 31 5d ing repeat a 31]
b8b0: 0a 09 73 65 74 20 73 65 63 6f 6e 64 62 6c 6f 63 ..set secondbloc
b8c0: 6b 20 5b 73 74 72 69 6e 67 20 72 65 70 65 61 74 k [string repeat
b8d0: 20 62 20 36 35 35 33 35 5d 0a 09 73 65 74 20 6c b 65535]..set l
b8e0: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
b8f0: 09 09 2d 63 65 72 74 66 69 6c 65 20 24 73 65 72 ..-certfile $ser
b900: 76 65 72 43 65 72 74 20 2d 63 61 66 69 6c 65 20 verCert -cafile
b910: 24 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 $caCert -keyfile
b920: 20 24 73 65 72 76 65 72 4b 65 79 20 5c 0a 09 09 $serverKey \...
b930: 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 -server accept 8
b940: 38 34 35 5d 0a 09 70 72 6f 63 20 61 63 63 65 70 845]..proc accep
b950: 74 20 7b 73 20 61 20 70 7d 20 7b 0a 09 20 20 20 t {s a p} {..
b960: 20 74 6c 73 3a 3a 68 61 6e 64 73 68 61 6b 65 20 tls::handshake
b970: 24 73 0a 09 20 20 20 20 66 63 6f 6e 66 69 67 75 $s.. fconfigu
b980: 72 65 20 24 73 20 2d 62 6c 6f 63 6b 69 6e 67 20 re $s -blocking
b990: 30 20 2d 74 72 61 6e 73 6c 61 74 69 6f 6e 20 6c 0 -translation l
b9a0: 66 20 2d 62 75 66 66 65 72 73 69 7a 65 20 31 36 f -buffersize 16
b9b0: 33 38 34 20 5c 0a 09 09 20 20 20 20 2d 62 75 66 384 \... -buf
b9c0: 66 65 72 69 6e 67 20 6c 69 6e 65 0a 09 20 20 20 fering line..
b9d0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 fileevent $s re
b9e0: 61 64 61 62 6c 65 20 22 72 65 61 64 61 62 6c 65 adable "readable
b9f0: 20 24 73 22 0a 09 7d 0a 09 70 72 6f 63 20 72 65 $s"..}..proc re
ba00: 61 64 61 62 6c 65 20 7b 73 7d 20 7b 0a 09 20 20 adable {s} {..
ba10: 20 20 73 65 74 20 6c 20 5b 67 65 74 73 20 24 73 set l [gets $s
ba20: 5d 0a 09 20 20 20 20 66 69 6c 65 65 76 65 6e 74 ].. fileevent
ba30: 20 24 73 20 72 65 61 64 61 62 6c 65 20 7b 7d 0a $s readable {}.
ba40: 09 20 20 20 20 61 66 74 65 72 20 31 30 30 30 20 . after 1000
ba50: 72 65 73 70 6f 6e 64 20 24 73 0a 09 7d 0a 09 70 respond $s..}..p
ba60: 72 6f 63 20 72 65 73 70 6f 6e 64 20 7b 73 7d 20 roc respond {s}
ba70: 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 66 69 {.. global fi
ba80: 72 73 74 62 6c 6f 63 6b 0a 09 20 20 20 20 70 75 rstblock.. pu
ba90: 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 24 73 ts -nonewline $s
baa0: 20 24 66 69 72 73 74 62 6c 6f 63 6b 0a 09 20 20 $firstblock..
bab0: 20 20 61 66 74 65 72 20 31 30 30 30 20 77 72 69 after 1000 wri
bac0: 74 65 64 61 74 61 20 24 73 0a 09 7d 0a 09 70 72 tedata $s..}..pr
bad0: 6f 63 20 77 72 69 74 65 64 61 74 61 20 7b 73 7d oc writedata {s}
bae0: 20 7b 0a 09 20 20 20 20 67 6c 6f 62 61 6c 20 73 {.. global s
baf0: 65 63 6f 6e 64 62 6c 6f 63 6b 0a 09 20 20 20 20 econdblock..
bb00: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 puts -nonewline
bb10: 24 73 20 24 73 65 63 6f 6e 64 62 6c 6f 63 6b 0a $s $secondblock.
bb20: 09 20 20 20 20 63 6c 6f 73 65 20 24 73 0a 09 7d . close $s..}
bb30: 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74 20 73 . }. set s
bb40: 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a [tls::socket \.
bb50: 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 20 24 . -certfile $
bb60: 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 clientCert -cafi
bb70: 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 66 le $caCert -keyf
bb80: 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 5c ile $clientKey \
bb90: 0a 09 20 20 20 20 24 72 65 6d 6f 74 65 53 65 72 .. $remoteSer
bba0: 76 65 72 49 50 20 38 38 34 35 5d 0a 20 20 20 20 verIP 8845].
bbb0: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
bbc0: 6c 6f 63 6b 69 6e 67 20 30 20 2d 74 72 61 6e 73 locking 0 -trans
bbd0: 6c 61 74 69 6f 6e 20 6c 66 20 2d 62 75 66 66 65 lation lf -buffe
bbe0: 72 69 6e 67 20 6c 69 6e 65 0a 20 20 20 20 73 65 ring line. se
bbf0: 74 20 63 6f 75 6e 74 20 30 0a 20 20 20 20 70 75 t count 0. pu
bc00: 74 73 20 24 73 20 68 65 6c 6c 6f 0a 20 20 20 20 ts $s hello.
bc10: 66 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 fileevent $s rea
bc20: 64 61 62 6c 65 20 22 72 65 61 64 69 74 20 24 73 dable "readit $s
bc30: 22 0a 20 20 20 20 73 65 74 20 74 69 6d 65 72 20 ". set timer
bc40: 5b 61 66 74 65 72 20 31 30 30 30 30 20 22 73 65 [after 10000 "se
bc50: 74 20 64 6f 6e 65 20 74 69 6d 65 64 5f 6f 75 74 t done timed_out
bc60: 22 5d 0a 20 20 20 20 76 77 61 69 74 20 64 6f 6e "]. vwait don
bc70: 65 0a 20 20 20 20 61 66 74 65 72 20 63 61 6e 63 e. after canc
bc80: 65 6c 20 24 74 69 6d 65 72 0a 20 20 20 20 73 65 el $timer. se
bc90: 6e 64 43 6f 6d 6d 61 6e 64 20 7b 63 6c 6f 73 65 ndCommand {close
bca0: 20 24 6c 7d 0a 20 20 20 20 73 65 74 20 63 6f 75 $l}. set cou
bcb0: 6e 74 0a 7d 20 36 35 35 36 36 0a 0a 70 72 6f 63 nt.} 65566..proc
bcc0: 20 67 65 74 64 61 74 61 20 7b 74 79 70 65 20 66 getdata {type f
bcd0: 69 6c 65 7d 20 7b 0a 20 20 20 20 23 20 52 65 61 ile} {. # Rea
bce0: 64 20 68 61 6e 64 6c 65 72 20 6f 6e 20 74 68 65 d handler on the
bcf0: 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 74 accepted socket
bd00: 2e 0a 20 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 .. global x.
bd10: 20 20 20 67 6c 6f 62 61 6c 20 66 61 69 6c 65 64 global failed
bd20: 0a 20 20 20 20 73 65 74 20 73 74 61 74 75 73 20 . set status
bd30: 5b 63 61 74 63 68 20 7b 72 65 61 64 20 24 66 69 [catch {read $fi
bd40: 6c 65 7d 20 64 61 74 61 5d 0a 20 20 20 20 69 66 le} data]. if
bd50: 20 7b 24 73 74 61 74 75 73 20 21 3d 20 30 7d 20 {$status != 0}
bd60: 7b 0a 09 73 65 74 20 78 20 22 72 65 61 64 20 66 {..set x "read f
bd70: 61 69 6c 65 64 2c 20 65 72 72 6f 72 20 77 61 73 ailed, error was
bd80: 20 24 64 61 74 61 22 0a 09 63 61 74 63 68 20 7b $data"..catch {
bd90: 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 close $file }.
bda0: 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 5b 73 74 } elseif {[st
bdb0: 72 69 6e 67 20 63 6f 6d 70 61 72 65 20 7b 7d 20 ring compare {}
bdc0: 24 64 61 74 61 5d 7d 20 7b 0a 20 20 20 20 7d 20 $data]} {. }
bdd0: 65 6c 73 65 69 66 20 7b 5b 66 62 6c 6f 63 6b 65 elseif {[fblocke
bde0: 64 20 24 66 69 6c 65 5d 7d 20 7b 0a 20 20 20 20 d $file]} {.
bdf0: 7d 20 65 6c 73 65 69 66 20 7b 5b 65 6f 66 20 24 } elseif {[eof $
be00: 66 69 6c 65 5d 7d 20 7b 0a 09 69 66 20 7b 24 66 file]} {..if {$f
be10: 61 69 6c 65 64 7d 20 7b 0a 09 20 20 20 20 73 65 ailed} {.. se
be20: 74 20 78 20 22 24 74 79 70 65 20 73 6f 63 6b 65 t x "$type socke
be30: 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 22 t was inherited"
be40: 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 ..} else {..
be50: 73 65 74 20 78 20 22 24 74 79 70 65 20 73 6f 63 set x "$type soc
be60: 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 ket was not inhe
be70: 72 69 74 65 64 22 0a 09 7d 0a 09 63 61 74 63 68 rited"..}..catch
be80: 20 7b 20 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d { close $file }
be90: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
bea0: 65 74 20 78 20 7b 69 6d 70 6f 73 73 69 62 6c 65 et x {impossible
beb0: 20 63 61 73 65 7d 0a 09 63 61 74 63 68 20 7b 20 case}..catch {
bec0: 63 6c 6f 73 65 20 24 66 69 6c 65 20 7d 0a 20 20 close $file }.
bed0: 20 20 7d 0a 20 20 20 20 72 65 74 75 72 6e 0a 7d }. return.}
bee0: 0a 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 32 2e ..test tlsIO-12.
bef0: 31 20 7b 74 65 73 74 69 6e 67 20 69 6e 68 65 72 1 {testing inher
bf00: 69 74 61 6e 63 65 20 6f 66 20 73 65 72 76 65 72 itance of server
bf10: 20 73 6f 63 6b 65 74 73 7d 20 7b 73 6f 63 6b 65 sockets} {socke
bf20: 74 20 65 78 65 63 7d 20 7b 0a 20 20 20 20 6d 61 t exec} {. ma
bf30: 6b 65 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 keFile {} script
bf40: 31 0a 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 1. makeFile {
bf50: 7d 20 73 63 72 69 70 74 32 0a 0a 20 20 20 20 23 } script2.. #
bf60: 20 53 63 72 69 70 74 31 20 69 73 20 6a 75 73 74 Script1 is just
bf70: 20 61 20 31 30 20 73 65 63 6f 6e 64 20 64 65 6c a 10 second del
bf80: 61 79 2e 20 20 49 66 20 74 68 65 20 73 65 72 76 ay. If the serv
bf90: 65 72 20 73 6f 63 6b 65 74 0a 20 20 20 20 23 20 er socket. #
bfa0: 69 73 20 69 6e 68 65 72 69 74 65 64 2c 20 69 74 is inherited, it
bfb0: 20 77 69 6c 6c 20 62 65 20 68 65 6c 64 20 6f 70 will be held op
bfc0: 65 6e 20 66 6f 72 20 31 30 20 73 65 63 6f 6e 64 en for 10 second
bfd0: 73 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 s.. set f [op
bfe0: 65 6e 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 en script1 w].
bff0: 20 20 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 puts $f {..aft
c000: 65 72 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 er 10000 exit..v
c010: 77 61 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 wait forever.
c020: 20 7d 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a }. close $f.
c030: 0a 20 20 20 20 23 20 53 63 72 69 70 74 32 20 63 . # Script2 c
c040: 72 65 61 74 65 73 20 74 68 65 20 73 65 72 76 65 reates the serve
c050: 72 20 73 6f 63 6b 65 74 2c 20 6c 61 75 6e 63 68 r socket, launch
c060: 65 73 20 73 63 72 69 70 74 31 2c 0a 20 20 20 20 es script1,.
c070: 23 20 77 61 69 74 73 20 61 20 73 65 63 6f 6e 64 # waits a second
c080: 2c 20 61 6e 64 20 65 78 69 74 73 2e 20 20 54 68 , and exits. Th
c090: 65 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 e server socket
c0a0: 77 69 6c 6c 20 6e 6f 77 0a 20 20 20 20 23 20 62 will now. # b
c0b0: 65 20 63 6c 6f 73 65 64 20 75 6e 6c 65 73 73 20 e closed unless
c0c0: 73 63 72 69 70 74 31 20 69 6e 68 65 72 69 74 65 script1 inherite
c0d0: 64 20 69 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 d it... set f
c0e0: 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 32 20 77 [open script2 w
c0f0: 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b 6c ]. puts $f [l
c100: 69 73 74 20 73 65 74 20 74 63 6c 73 68 20 24 3a ist set tclsh $:
c110: 3a 74 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 :tcltest::tcltes
c120: 74 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 5b t]. puts $f [
c130: 6c 69 73 74 20 73 65 74 20 61 75 74 6f 5f 70 61 list set auto_pa
c140: 74 68 20 24 61 75 74 6f 5f 70 61 74 68 5d 0a 20 th $auto_path].
c150: 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 70 61 puts $f {..pa
c160: 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 6c ckage require tl
c170: 73 0a 20 20 20 20 7d 0a 20 20 20 20 70 75 74 73 s. }. puts
c180: 20 24 66 20 22 73 65 74 20 66 20 5c 5b 74 6c 73 $f "set f \[tls
c190: 3a 3a 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 ::socket -server
c1a0: 20 61 63 63 65 70 74 20 5c 0a 09 20 20 20 20 2d accept \.. -
c1b0: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
c1c0: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
c1d0: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
c1e0: 65 72 76 65 72 4b 65 79 20 38 38 32 38 5c 5d 22 erverKey 8828\]"
c1f0: 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b 0a 09 . puts $f {..
c200: 70 72 6f 63 20 61 63 63 65 70 74 20 7b 20 66 69 proc accept { fi
c210: 6c 65 20 61 64 64 72 20 70 6f 72 74 20 7d 20 7b le addr port } {
c220: 0a 09 20 20 20 20 63 6c 6f 73 65 20 24 66 69 6c .. close $fil
c230: 65 0a 09 7d 0a 09 65 78 65 63 20 24 74 63 6c 73 e..}..exec $tcls
c240: 68 20 73 63 72 69 70 74 31 20 26 0a 09 63 6c 6f h script1 &..clo
c250: 73 65 20 24 66 0a 09 61 66 74 65 72 20 31 30 30 se $f..after 100
c260: 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 6f 0 exit..vwait fo
c270: 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 20 rever. }.
c280: 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 20 close $f.. #
c290: 4c 61 75 6e 63 68 20 73 63 72 69 70 74 32 20 61 Launch script2 a
c2a0: 6e 64 20 77 61 69 74 20 35 20 73 65 63 6f 6e 64 nd wait 5 second
c2b0: 73 0a 0a 20 20 20 20 65 78 65 63 20 24 3a 3a 74 s.. exec $::t
c2c0: 63 6c 74 65 73 74 3a 3a 74 63 6c 74 65 73 74 20 cltest::tcltest
c2d0: 73 63 72 69 70 74 32 20 26 0a 20 20 20 20 61 66 script2 &. af
c2e0: 74 65 72 20 35 30 30 30 20 7b 20 73 65 74 20 6f ter 5000 { set o
c2f0: 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 20 31 20 7d k_to_proceed 1 }
c300: 0a 20 20 20 20 76 77 61 69 74 20 6f 6b 5f 74 6f . vwait ok_to
c310: 5f 70 72 6f 63 65 65 64 0a 0a 20 20 20 20 23 20 _proceed.. #
c320: 49 66 20 77 65 20 63 61 6e 20 73 74 69 6c 6c 20 If we can still
c330: 63 6f 6e 6e 65 63 74 20 74 6f 20 74 68 65 20 73 connect to the s
c340: 65 72 76 65 72 2c 20 74 68 65 20 73 6f 63 6b 65 erver, the socke
c350: 74 20 67 6f 74 20 69 6e 68 65 72 69 74 65 64 2e t got inherited.
c360: 0a 0a 20 20 20 20 69 66 20 7b 5b 63 61 74 63 68 .. if {[catch
c370: 20 7b 74 6c 73 3a 3a 73 6f 63 6b 65 74 20 5c 0a {tls::socket \.
c380: 09 2d 63 65 72 74 66 69 6c 65 20 24 63 6c 69 65 .-certfile $clie
c390: 6e 74 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 ntCert -cafile $
c3a0: 63 61 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 caCert -keyfile
c3b0: 24 63 6c 69 65 6e 74 4b 65 79 20 5c 0a 20 20 20 $clientKey \.
c3c0: 09 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 38 . 127.0.0.1 8828
c3d0: 7d 20 6d 73 67 5d 7d 20 7b 0a 09 73 65 74 20 78 } msg]} {..set x
c3e0: 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 74 20 {server socket
c3f0: 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 69 74 65 was not inherite
c400: 64 7d 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a d}. } else {.
c410: 09 63 6c 6f 73 65 20 24 6d 73 67 0a 09 73 65 74 .close $msg..set
c420: 20 78 20 7b 73 65 72 76 65 72 20 73 6f 63 6b 65 x {server socke
c430: 74 20 77 61 73 20 69 6e 68 65 72 69 74 65 64 7d t was inherited}
c440: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 . }.. set
c450: 78 0a 7d 20 7b 73 65 72 76 65 72 20 73 6f 63 6b x.} {server sock
c460: 65 74 20 77 61 73 20 6e 6f 74 20 69 6e 68 65 72 et was not inher
c470: 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 6c 73 49 ited}..test tlsI
c480: 4f 2d 31 32 2e 32 20 7b 74 65 73 74 69 6e 67 20 O-12.2 {testing
c490: 69 6e 68 65 72 69 74 61 6e 63 65 20 6f 66 20 63 inheritance of c
c4a0: 6c 69 65 6e 74 20 73 6f 63 6b 65 74 73 7d 20 7b lient sockets} {
c4b0: 73 6f 63 6b 65 74 20 65 78 65 63 7d 20 7b 0a 20 socket exec} {.
c4c0: 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 73 makeFile {} s
c4d0: 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 46 cript1. makeF
c4e0: 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 0a 0a ile {} script2..
c4f0: 20 20 20 20 23 20 53 63 72 69 70 74 31 20 69 73 # Script1 is
c500: 20 6a 75 73 74 20 61 20 31 30 20 73 65 63 6f 6e just a 10 secon
c510: 64 20 64 65 6c 61 79 2e 20 20 49 66 20 74 68 65 d delay. If the
c520: 20 73 65 72 76 65 72 20 73 6f 63 6b 65 74 0a 20 server socket.
c530: 20 20 20 23 20 69 73 20 69 6e 68 65 72 69 74 65 # is inherite
c540: 64 2c 20 69 74 20 77 69 6c 6c 20 62 65 20 68 65 d, it will be he
c550: 6c 64 20 6f 70 65 6e 20 66 6f 72 20 31 30 20 73 ld open for 10 s
c560: 65 63 6f 6e 64 73 0a 0a 20 20 20 20 73 65 74 20 econds.. set
c570: 66 20 5b 6f 70 65 6e 20 73 63 72 69 70 74 31 20 f [open script1
c580: 77 5d 0a 20 20 20 20 70 75 74 73 20 24 66 20 7b w]. puts $f {
c590: 0a 09 61 66 74 65 72 20 31 30 30 30 30 20 65 78 ..after 10000 ex
c5a0: 69 74 0a 09 76 77 61 69 74 20 66 6f 72 65 76 65 it..vwait foreve
c5b0: 72 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f 73 r. }. clos
c5c0: 65 20 24 66 0a 0a 20 20 20 20 23 20 53 63 72 69 e $f.. # Scri
c5d0: 70 74 32 20 6f 70 65 6e 73 20 74 68 65 20 63 6c pt2 opens the cl
c5e0: 69 65 6e 74 20 73 6f 63 6b 65 74 20 61 6e 64 20 ient socket and
c5f0: 77 72 69 74 65 73 20 74 6f 20 69 74 2e 20 20 49 writes to it. I
c600: 74 20 74 68 65 6e 0a 20 20 20 20 23 20 6c 61 75 t then. # lau
c610: 6e 63 68 65 73 20 73 63 72 69 70 74 31 20 61 6e nches script1 an
c620: 64 20 65 78 69 74 73 2e 20 20 49 66 20 74 68 65 d exits. If the
c630: 20 63 68 69 6c 64 20 70 72 6f 63 65 73 73 20 69 child process i
c640: 6e 68 65 72 69 74 65 64 20 74 68 65 0a 20 20 20 nherited the.
c650: 20 23 20 63 6c 69 65 6e 74 20 73 6f 63 6b 65 74 # client socket
c660: 2c 20 74 68 65 20 73 6f 63 6b 65 74 20 77 69 6c , the socket wil
c670: 6c 20 73 74 69 6c 6c 20 62 65 20 6f 70 65 6e 2e l still be open.
c680: 0a 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 .. set f [ope
c690: 6e 20 73 63 72 69 70 74 32 20 77 5d 0a 20 20 20 n script2 w].
c6a0: 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 puts $f [list s
c6b0: 65 74 20 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 et tclsh $::tclt
c6c0: 65 73 74 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 est::tcltest].
c6d0: 20 20 70 75 74 73 20 24 66 20 5b 6c 69 73 74 20 puts $f [list
c6e0: 73 65 74 20 61 75 74 6f 5f 70 61 74 68 20 24 61 set auto_path $a
c6f0: 75 74 6f 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 uto_path]. pu
c700: 74 73 20 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 ts $f {..package
c710: 20 72 65 71 75 69 72 65 20 74 6c 73 0a 20 20 20 require tls.
c720: 20 7d 0a 20 20 20 20 70 75 74 73 20 24 66 20 22 }. puts $f "
c730: 73 65 74 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 set f \[tls::soc
c740: 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 24 63 ket -certfile $c
c750: 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 69 6c lientCert -cafil
c760: 65 20 24 63 61 43 65 72 74 20 5c 0a 09 20 20 20 e $caCert \..
c770: 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c 69 65 6e -keyfile $clien
c780: 74 4b 65 79 20 31 32 37 2e 30 2e 30 2e 31 20 38 tKey 127.0.0.1 8
c790: 38 32 39 5c 5d 22 0a 20 20 20 20 70 75 74 73 20 829\]". puts
c7a0: 24 66 20 7b 0a 09 65 78 65 63 20 24 74 63 6c 73 $f {..exec $tcls
c7b0: 68 20 73 63 72 69 70 74 31 20 26 0a 09 70 75 74 h script1 &..put
c7c0: 73 20 24 66 20 74 65 73 74 69 6e 67 0a 09 66 6c s $f testing..fl
c7d0: 75 73 68 20 24 66 0a 09 61 66 74 65 72 20 31 30 ush $f..after 10
c7e0: 30 30 20 65 78 69 74 0a 09 76 77 61 69 74 20 66 00 exit..vwait f
c7f0: 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 20 20 orever. }.
c800: 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 20 23 close $f.. #
c810: 20 43 72 65 61 74 65 20 74 68 65 20 73 65 72 76 Create the serv
c820: 65 72 20 73 6f 63 6b 65 74 0a 0a 20 20 20 20 73 er socket.. s
c830: 65 74 20 73 65 72 76 65 72 20 5b 74 6c 73 3a 3a et server [tls::
c840: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
c850: 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 43 ertfile $serverC
c860: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
c870: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 65 ert -keyfile $se
c880: 72 76 65 72 4b 65 79 20 5c 0a 09 20 20 20 20 2d rverKey \.. -
c890: 73 65 72 76 65 72 20 61 63 63 65 70 74 20 38 38 server accept 88
c8a0: 32 39 5d 0a 20 20 20 20 70 72 6f 63 20 61 63 63 29]. proc acc
c8b0: 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 ept { file host
c8c0: 70 6f 72 74 20 7d 20 7b 0a 09 23 20 57 68 65 6e port } {..# When
c8d0: 20 74 68 65 20 63 6c 69 65 6e 74 20 63 6f 6e 6e the client conn
c8e0: 65 63 74 73 2c 20 65 73 74 61 62 6c 69 73 68 20 ects, establish
c8f0: 74 68 65 20 72 65 61 64 20 68 61 6e 64 6c 65 72 the read handler
c900: 0a 09 67 6c 6f 62 61 6c 20 73 65 72 76 65 72 0a ..global server.
c910: 09 63 6c 6f 73 65 20 24 73 65 72 76 65 72 0a 09 .close $server..
c920: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 fconfigure $file
c930: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 09 66 69 -blocking 0..fi
c940: 6c 65 65 76 65 6e 74 20 24 66 69 6c 65 20 72 65 leevent $file re
c950: 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 64 6f 5f adable [list do_
c960: 68 61 6e 64 73 68 61 6b 65 20 24 66 69 6c 65 20 handshake $file
c970: 72 65 61 64 61 62 6c 65 20 5c 0a 09 09 5b 6c 69 readable \...[li
c980: 73 74 20 67 65 74 64 61 74 61 20 63 6c 69 65 6e st getdata clien
c990: 74 5d 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 t] -buffering li
c9a0: 6e 65 5d 0a 09 72 65 74 75 72 6e 0a 20 20 20 20 ne]..return.
c9b0: 7d 0a 0a 20 20 20 20 23 20 49 66 20 74 68 65 20 }.. # If the
c9c0: 73 6f 63 6b 65 74 20 64 6f 65 73 6e 27 74 20 68 socket doesn't h
c9d0: 69 74 20 65 6e 64 2d 6f 66 2d 66 69 6c 65 20 69 it end-of-file i
c9e0: 6e 20 35 20 73 65 63 6f 6e 64 73 2c 20 74 68 65 n 5 seconds, the
c9f0: 0a 20 20 20 20 23 20 73 63 72 69 70 74 31 20 70 . # script1 p
ca00: 72 6f 63 65 73 73 20 6d 75 73 74 20 68 61 76 65 rocess must have
ca10: 20 69 6e 68 65 72 69 74 65 64 20 74 68 65 20 63 inherited the c
ca20: 6c 69 65 6e 74 2e 0a 0a 20 20 20 20 73 65 74 20 lient... set
ca30: 66 61 69 6c 65 64 20 30 0a 20 20 20 20 61 66 74 failed 0. aft
ca40: 65 72 20 35 30 30 30 20 5b 6c 69 73 74 20 73 65 er 5000 [list se
ca50: 74 20 66 61 69 6c 65 64 20 31 5d 0a 0a 20 20 20 t failed 1]..
ca60: 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 # Launch the sc
ca70: 72 69 70 74 32 20 70 72 6f 63 65 73 73 0a 0a 20 ript2 process..
ca80: 20 20 20 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 exec $::tclte
ca90: 73 74 3a 3a 74 63 6c 74 65 73 74 20 73 63 72 69 st::tcltest scri
caa0: 70 74 32 20 26 0a 0a 20 20 20 20 76 77 61 69 74 pt2 &.. vwait
cab0: 20 78 0a 20 20 20 20 69 66 20 7b 21 24 66 61 69 x. if {!$fai
cac0: 6c 65 64 7d 20 7b 0a 09 76 77 61 69 74 20 66 61 led} {..vwait fa
cad0: 69 6c 65 64 0a 20 20 20 20 7d 0a 20 20 20 20 73 iled. }. s
cae0: 65 74 20 78 0a 7d 20 7b 63 6c 69 65 6e 74 20 73 et x.} {client s
caf0: 6f 63 6b 65 74 20 77 61 73 20 6e 6f 74 20 69 6e ocket was not in
cb00: 68 65 72 69 74 65 64 7d 0a 0a 74 65 73 74 20 74 herited}..test t
cb10: 6c 73 49 4f 2d 31 32 2e 33 20 7b 74 65 73 74 69 lsIO-12.3 {testi
cb20: 6e 67 20 69 6e 68 65 72 69 74 61 6e 63 65 20 6f ng inheritance o
cb30: 66 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 f accepted socke
cb40: 74 73 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 65 ts} \..{socket e
cb50: 78 65 63 20 75 6e 69 78 4f 6e 6c 79 7d 20 7b 0a xec unixOnly} {.
cb60: 20 20 20 20 6d 61 6b 65 46 69 6c 65 20 7b 7d 20 makeFile {}
cb70: 73 63 72 69 70 74 31 0a 20 20 20 20 6d 61 6b 65 script1. make
cb80: 46 69 6c 65 20 7b 7d 20 73 63 72 69 70 74 32 0a File {} script2.
cb90: 0a 20 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e . set f [open
cba0: 20 73 63 72 69 70 74 31 20 77 5d 0a 20 20 20 20 script1 w].
cbb0: 70 75 74 73 20 24 66 20 7b 0a 09 61 66 74 65 72 puts $f {..after
cbc0: 20 31 30 30 30 30 20 65 78 69 74 0a 09 76 77 61 10000 exit..vwa
cbd0: 69 74 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d it forever. }
cbe0: 0a 20 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 . close $f..
cbf0: 20 20 20 73 65 74 20 66 20 5b 6f 70 65 6e 20 73 set f [open s
cc00: 63 72 69 70 74 32 20 77 5d 0a 20 20 20 20 70 75 cript2 w]. pu
cc10: 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 20 ts $f [list set
cc20: 74 63 6c 73 68 20 24 3a 3a 74 63 6c 74 65 73 74 tclsh $::tcltest
cc30: 3a 3a 74 63 6c 74 65 73 74 5d 0a 20 20 20 20 70 ::tcltest]. p
cc40: 75 74 73 20 24 66 20 5b 6c 69 73 74 20 73 65 74 uts $f [list set
cc50: 20 61 75 74 6f 5f 70 61 74 68 20 24 61 75 74 6f auto_path $auto
cc60: 5f 70 61 74 68 5d 0a 20 20 20 20 70 75 74 73 20 _path]. puts
cc70: 24 66 20 7b 0a 09 70 61 63 6b 61 67 65 20 72 65 $f {..package re
cc80: 71 75 69 72 65 20 74 6c 73 0a 20 20 20 20 7d 0a quire tls. }.
cc90: 20 20 20 20 70 75 74 73 20 24 66 20 22 73 65 74 puts $f "set
cca0: 20 66 20 5c 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 f \[tls::socket
ccb0: 20 2d 73 65 72 76 65 72 20 61 63 63 65 70 74 20 -server accept
ccc0: 5c 0a 09 20 20 20 20 2d 63 65 72 74 66 69 6c 65 \.. -certfile
ccd0: 20 24 73 65 72 76 65 72 43 65 72 74 20 2d 63 61 $serverCert -ca
cce0: 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 file $caCert -ke
ccf0: 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b 65 79 yfile $serverKey
cd00: 20 38 39 33 30 5c 5d 22 0a 20 20 20 20 70 75 74 8930\]". put
cd10: 73 20 24 66 20 7b 0a 09 70 72 6f 63 20 61 63 63 s $f {..proc acc
cd20: 65 70 74 20 7b 20 66 69 6c 65 20 68 6f 73 74 20 ept { file host
cd30: 70 6f 72 74 20 7d 20 7b 0a 09 20 20 20 20 67 6c port } {.. gl
cd40: 6f 62 61 6c 20 74 63 6c 73 68 0a 09 20 20 20 20 obal tclsh..
cd50: 66 63 6f 6e 66 69 67 75 72 65 20 24 66 69 6c 65 fconfigure $file
cd60: 20 2d 62 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 -buffering line
cd70: 0a 09 20 20 20 20 70 75 74 73 20 24 66 69 6c 65 .. puts $file
cd80: 20 7b 74 65 73 74 20 64 61 74 61 20 6f 6e 20 73 {test data on s
cd90: 6f 63 6b 65 74 7d 0a 09 20 20 20 20 65 78 65 63 ocket}.. exec
cda0: 20 24 74 63 6c 73 68 20 73 63 72 69 70 74 31 20 $tclsh script1
cdb0: 26 0a 09 20 20 20 20 61 66 74 65 72 20 31 30 30 &.. after 100
cdc0: 30 20 65 78 69 74 0a 09 7d 0a 09 76 77 61 69 74 0 exit..}..vwait
cdd0: 20 66 6f 72 65 76 65 72 0a 20 20 20 20 7d 0a 20 forever. }.
cde0: 20 20 20 63 6c 6f 73 65 20 24 66 0a 0a 20 20 20 close $f..
cdf0: 20 23 20 4c 61 75 6e 63 68 20 74 68 65 20 73 63 # Launch the sc
ce00: 72 69 70 74 32 20 70 72 6f 63 65 73 73 20 61 6e ript2 process an
ce10: 64 20 63 6f 6e 6e 65 63 74 20 74 6f 20 69 74 2e d connect to it.
ce20: 20 20 53 65 65 20 68 6f 77 20 6c 6f 6e 67 0a 20 See how long.
ce30: 20 20 20 23 20 74 68 65 20 73 6f 63 6b 65 74 20 # the socket
ce40: 73 74 61 79 73 20 6f 70 65 6e 0a 0a 20 20 20 20 stays open..
ce50: 65 78 65 63 20 24 3a 3a 74 63 6c 74 65 73 74 3a exec $::tcltest:
ce60: 3a 74 63 6c 74 65 73 74 20 73 63 72 69 70 74 32 :tcltest script2
ce70: 20 26 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 &.. after 20
ce80: 30 30 20 73 65 74 20 6f 6b 5f 74 6f 5f 70 72 6f 00 set ok_to_pro
ce90: 63 65 65 64 20 31 0a 20 20 20 20 76 77 61 69 74 ceed 1. vwait
cea0: 20 6f 6b 5f 74 6f 5f 70 72 6f 63 65 65 64 0a 0a ok_to_proceed..
ceb0: 20 20 20 20 73 65 74 20 66 20 5b 74 6c 73 3a 3a set f [tls::
cec0: 73 6f 63 6b 65 74 20 5c 0a 09 20 20 20 20 2d 63 socket \.. -c
ced0: 65 72 74 66 69 6c 65 20 24 63 6c 69 65 6e 74 43 ertfile $clientC
cee0: 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 43 ert -cafile $caC
cef0: 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 63 6c ert -keyfile $cl
cf00: 69 65 6e 74 4b 65 79 20 5c 0a 09 20 20 20 20 31 ientKey \.. 1
cf10: 32 37 2e 30 2e 30 2e 31 20 38 39 33 30 5d 0a 20 27.0.0.1 8930].
cf20: 20 20 20 66 63 6f 6e 66 69 67 75 72 65 20 24 66 fconfigure $f
cf30: 20 2d 62 75 66 66 65 72 69 6e 67 20 66 75 6c 6c -buffering full
cf40: 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0a 20 20 20 -blocking 0.
cf50: 20 23 20 57 65 20 6e 65 65 64 20 74 6f 20 70 75 # We need to pu
cf60: 74 20 61 20 62 79 74 65 20 69 6e 74 6f 20 74 68 t a byte into th
cf70: 65 20 72 65 61 64 20 71 75 65 75 65 2c 20 6f 74 e read queue, ot
cf80: 68 65 72 77 69 73 65 20 74 68 65 0a 20 20 20 20 herwise the.
cf90: 23 20 54 4c 53 20 68 61 6e 64 73 68 61 6b 65 20 # TLS handshake
cfa0: 64 6f 65 73 6e 27 74 20 66 69 6e 69 73 68 0a 20 doesn't finish.
cfb0: 20 20 20 70 75 74 73 20 24 66 20 61 3b 20 66 6c puts $f a; fl
cfc0: 75 73 68 20 24 66 0a 20 20 20 20 66 69 6c 65 65 ush $f. filee
cfd0: 76 65 6e 74 20 24 66 20 72 65 61 64 61 62 6c 65 vent $f readable
cfe0: 20 5b 6c 69 73 74 20 67 65 74 64 61 74 61 20 61 [list getdata a
cff0: 63 63 65 70 74 65 64 20 24 66 5d 0a 0a 20 20 20 ccepted $f]..
d000: 20 23 20 49 66 20 74 68 65 20 73 6f 63 6b 65 74 # If the socket
d010: 20 69 73 20 73 74 69 6c 6c 20 6f 70 65 6e 20 61 is still open a
d020: 66 74 65 72 20 35 20 73 65 63 6f 6e 64 73 2c 20 fter 5 seconds,
d030: 74 68 65 20 73 63 72 69 70 74 31 20 70 72 6f 63 the script1 proc
d040: 65 73 73 0a 20 20 20 20 23 20 6d 75 73 74 20 68 ess. # must h
d050: 61 76 65 20 69 6e 68 65 72 69 74 65 64 20 74 68 ave inherited th
d060: 65 20 61 63 63 65 70 74 65 64 20 73 6f 63 6b 65 e accepted socke
d070: 74 2e 0a 0a 20 20 20 20 73 65 74 20 66 61 69 6c t... set fail
d080: 65 64 20 30 0a 20 20 20 20 61 66 74 65 72 20 35 ed 0. after 5
d090: 30 30 30 20 73 65 74 20 66 61 69 6c 65 64 20 31 000 set failed 1
d0a0: 0a 0a 20 20 20 20 76 77 61 69 74 20 78 0a 20 20 .. vwait x.
d0b0: 20 20 73 65 74 20 78 0a 7d 20 7b 61 63 63 65 70 set x.} {accep
d0c0: 74 65 64 20 73 6f 63 6b 65 74 20 77 61 73 20 6e ted socket was n
d0d0: 6f 74 20 69 6e 68 65 72 69 74 65 64 7d 0a 0a 74 ot inherited}..t
d0e0: 65 73 74 20 74 6c 73 49 4f 2d 31 33 2e 31 20 7b est tlsIO-13.1 {
d0f0: 54 65 73 74 69 6e 67 20 75 73 65 20 6f 66 20 73 Testing use of s
d100: 68 61 72 65 64 20 73 6f 63 6b 65 74 20 62 65 74 hared socket bet
d110: 77 65 65 6e 20 74 77 6f 20 74 68 72 65 61 64 73 ween two threads
d120: 7d 20 5c 0a 09 7b 73 6f 63 6b 65 74 20 74 65 73 } \..{socket tes
d130: 74 74 68 72 65 61 64 7d 20 7b 0a 20 20 20 20 23 tthread} {. #
d140: 20 48 4f 42 42 53 3a 20 6e 65 76 65 72 20 74 65 HOBBS: never te
d150: 73 74 65 64 0a 20 20 20 20 72 65 6d 6f 76 65 46 sted. removeF
d160: 69 6c 65 20 73 63 72 69 70 74 0a 20 20 20 20 74 ile script. t
d170: 68 72 65 61 64 52 65 61 70 0a 0a 20 20 20 20 6d hreadReap.. m
d180: 61 6b 65 46 69 6c 65 20 7b 0a 20 20 20 20 09 70 akeFile {. .p
d190: 61 63 6b 61 67 65 20 72 65 71 75 69 72 65 20 74 ackage require t
d1a0: 6c 73 0a 09 73 65 74 20 66 20 5b 74 6c 73 3a 3a ls..set f [tls::
d1b0: 73 6f 63 6b 65 74 20 2d 73 65 72 76 65 72 20 61 socket -server a
d1c0: 63 63 65 70 74 20 38 38 32 38 5d 0a 09 70 72 6f ccept 8828]..pro
d1d0: 63 20 61 63 63 65 70 74 20 7b 73 20 61 20 70 7d c accept {s a p}
d1e0: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 {. f
d1f0: 69 6c 65 65 76 65 6e 74 20 24 73 20 72 65 61 64 ileevent $s read
d200: 61 62 6c 65 20 5b 6c 69 73 74 20 65 63 68 6f 20 able [list echo
d210: 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 $s].
d220: 66 63 6f 6e 66 69 67 75 72 65 20 24 73 20 2d 62 fconfigure $s -b
d230: 75 66 66 65 72 69 6e 67 20 6c 69 6e 65 0a 20 20 uffering line.
d240: 20 20 20 20 20 20 7d 0a 09 70 72 6f 63 20 65 63 }..proc ec
d250: 68 6f 20 7b 73 7d 20 7b 0a 09 20 20 20 20 20 67 ho {s} {.. g
d260: 6c 6f 62 61 6c 20 69 0a 20 20 20 20 20 20 20 20 lobal i.
d270: 20 20 20 20 20 73 65 74 20 6c 20 5b 67 65 74 73 set l [gets
d280: 20 24 73 5d 0a 20 20 20 20 20 20 20 20 20 20 20 $s].
d290: 20 20 69 66 20 7b 5b 65 6f 66 20 24 73 5d 7d 20 if {[eof $s]}
d2a0: 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 {.
d2b0: 20 20 20 67 6c 6f 62 61 6c 20 78 0a 20 20 20 20 global x.
d2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6c 6f clo
d2d0: 73 65 20 24 73 0a 20 20 20 20 20 20 20 20 20 20 se $s.
d2e0: 20 20 20 20 20 20 20 73 65 74 20 78 20 64 6f 6e set x don
d2f0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 7d e. }
d300: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 20 20 20 else {..
d310: 20 20 69 6e 63 72 20 69 0a 20 20 20 20 20 20 20 incr i.
d320: 20 20 20 20 20 20 20 20 20 20 70 75 74 73 20 24 puts $
d330: 73 20 24 6c 0a 20 20 20 20 20 20 20 20 20 20 20 s $l.
d340: 20 20 7d 0a 09 7d 0a 09 73 65 74 20 69 20 30 0a }..}..set i 0.
d350: 09 76 77 61 69 74 20 78 0a 09 63 6c 6f 73 65 20 .vwait x..close
d360: 24 66 0a 0a 09 23 20 74 68 72 65 61 64 20 63 6c $f...# thread cl
d370: 65 61 6e 73 20 69 74 73 65 6c 66 20 75 70 2e 0a eans itself up..
d380: 09 74 65 73 74 74 68 72 65 61 64 20 65 78 69 74 .testthread exit
d390: 0a 20 20 20 20 7d 20 73 63 72 69 70 74 0a 0a 20 . } script..
d3a0: 20 20 20 23 20 63 72 65 61 74 65 20 61 20 74 68 # create a th
d3b0: 72 65 61 64 0a 20 20 20 20 73 65 74 20 73 65 72 read. set ser
d3c0: 76 65 72 74 68 72 65 61 64 20 5b 74 65 73 74 74 verthread [testt
d3d0: 68 72 65 61 64 20 63 72 65 61 74 65 20 7b 20 73 hread create { s
d3e0: 6f 75 72 63 65 20 73 63 72 69 70 74 20 7d 20 5d ource script } ]
d3f0: 0a 20 20 20 20 75 70 64 61 74 65 0a 0a 20 20 20 . update..
d400: 20 61 66 74 65 72 20 31 30 30 30 0a 20 20 20 20 after 1000.
d410: 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f 63 6b set s [tls::sock
d420: 65 74 20 31 32 37 2e 30 2e 30 2e 31 20 38 38 32 et 127.0.0.1 882
d430: 38 5d 0a 20 20 20 20 66 63 6f 6e 66 69 67 75 72 8]. fconfigur
d440: 65 20 24 73 20 2d 62 75 66 66 65 72 69 6e 67 20 e $s -buffering
d450: 6c 69 6e 65 0a 0a 20 20 20 20 63 61 74 63 68 20 line.. catch
d460: 7b 0a 09 70 75 74 73 20 24 73 20 22 68 65 6c 6c {..puts $s "hell
d470: 6f 22 0a 09 67 65 74 73 20 24 73 20 72 65 73 75 o"..gets $s resu
d480: 6c 74 0a 20 20 20 20 7d 0a 20 20 20 20 63 6c 6f lt. }. clo
d490: 73 65 20 24 73 0a 20 20 20 20 75 70 64 61 74 65 se $s. update
d4a0: 0a 0a 20 20 20 20 61 66 74 65 72 20 32 30 30 30 .. after 2000
d4b0: 0a 20 20 20 20 6c 61 70 70 65 6e 64 20 72 65 73 . lappend res
d4c0: 75 6c 74 20 5b 74 68 72 65 61 64 52 65 61 70 5d ult [threadReap]
d4d0: 0a 0a 20 20 20 20 73 65 74 20 72 65 73 75 6c 74 .. set result
d4e0: 0a 0a 7d 20 7b 68 65 6c 6c 6f 20 31 7d 0a 0a 74 ..} {hello 1}..t
d4f0: 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 31 20 7b est tlsIO-14.1 {
d500: 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f test tls::unimpo
d510: 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 rt} {socket} {.
d520: 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 7b list [catch {
d530: 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 6d tls::unimport} m
d540: 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 7b 77 sg] $msg.} {1 {w
d550: 72 6f 6e 67 20 23 20 61 72 67 73 3a 20 73 68 6f rong # args: sho
d560: 75 6c 64 20 62 65 20 22 74 6c 73 3a 3a 75 6e 69 uld be "tls::uni
d570: 6d 70 6f 72 74 20 63 68 61 6e 6e 65 6c 22 7d 7d mport channel"}}
d580: 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 2e 32 .test tlsIO-14.2
d590: 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e 69 6d {test tls::unim
d5a0: 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d 20 7b port} {socket} {
d5b0: 0a 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 . list [catch
d5c0: 20 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 {tls::unimport
d5d0: 66 6f 6f 20 62 61 72 7d 20 6d 73 67 5d 20 24 6d foo bar} msg] $m
d5e0: 73 67 0a 7d 20 7b 31 20 7b 77 72 6f 6e 67 20 23 sg.} {1 {wrong #
d5f0: 20 61 72 67 73 3a 20 73 68 6f 75 6c 64 20 62 65 args: should be
d600: 20 22 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 "tls::unimport
d610: 63 68 61 6e 6e 65 6c 22 7d 7d 0a 74 65 73 74 20 channel"}}.test
d620: 74 6c 73 49 4f 2d 31 34 2e 33 20 7b 74 65 73 74 tlsIO-14.3 {test
d630: 20 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 7d 20 tls::unimport}
d640: 7b 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 6c {socket} {. l
d650: 69 73 74 20 5b 63 61 74 63 68 20 7b 74 6c 73 3a ist [catch {tls:
d660: 3a 75 6e 69 6d 70 6f 72 74 20 62 6f 67 75 73 7d :unimport bogus}
d670: 20 6d 73 67 5d 20 24 6d 73 67 0a 7d 20 7b 31 20 msg] $msg.} {1
d680: 7b 63 61 6e 20 6e 6f 74 20 66 69 6e 64 20 63 68 {can not find ch
d690: 61 6e 6e 65 6c 20 6e 61 6d 65 64 20 22 62 6f 67 annel named "bog
d6a0: 75 73 22 7d 7d 0a 74 65 73 74 20 74 6c 73 49 4f us"}}.test tlsIO
d6b0: 2d 31 34 2e 34 20 7b 74 65 73 74 20 74 6c 73 3a -14.4 {test tls:
d6c0: 3a 75 6e 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b :unimport} {sock
d6d0: 65 74 7d 20 7b 0a 20 20 20 20 23 20 73 74 64 69 et} {. # stdi
d6e0: 6e 20 63 61 6e 20 74 61 6b 65 20 64 69 66 66 65 n can take diffe
d6f0: 72 65 6e 74 20 6e 61 6d 65 73 20 61 73 20 74 68 rent names as th
d700: 65 20 22 74 6f 70 22 20 63 68 61 6e 6e 65 6c 0a e "top" channel.
d710: 20 20 20 20 6c 69 73 74 20 5b 63 61 74 63 68 20 list [catch
d720: 7b 74 6c 73 3a 3a 75 6e 69 6d 70 6f 72 74 20 73 {tls::unimport s
d730: 74 64 69 6e 7d 20 6d 73 67 5d 20 5c 0a 09 5b 73 tdin} msg] \..[s
d740: 74 72 69 6e 67 20 6d 61 74 63 68 20 7b 62 61 64 tring match {bad
d750: 20 63 68 61 6e 6e 65 6c 20 22 2a 22 3a 20 6e 6f channel "*": no
d760: 74 20 61 20 73 74 61 63 6b 65 64 20 63 68 61 6e t a stacked chan
d770: 6e 65 6c 7d 20 24 6d 73 67 5d 0a 7d 20 7b 31 20 nel} $msg].} {1
d780: 31 7d 0a 74 65 73 74 20 74 6c 73 49 4f 2d 31 34 1}.test tlsIO-14
d790: 2e 35 20 7b 74 65 73 74 20 74 6c 73 3a 3a 75 6e .5 {test tls::un
d7a0: 69 6d 70 6f 72 74 7d 20 7b 73 6f 63 6b 65 74 7d import} {socket}
d7b0: 20 7b 0a 20 20 20 20 73 65 74 20 6c 65 6e 20 30 {. set len 0
d7c0: 0a 20 20 20 20 73 65 74 20 73 70 75 72 69 6f 75 . set spuriou
d7d0: 73 20 30 0a 20 20 20 20 73 65 74 20 64 6f 6e 65 s 0. set done
d7e0: 20 30 0a 20 20 20 20 70 72 6f 63 20 72 65 61 64 0. proc read
d7f0: 6c 69 74 74 6c 65 20 7b 73 7d 20 7b 0a 09 67 6c little {s} {..gl
d800: 6f 62 61 6c 20 73 70 75 72 69 6f 75 73 20 64 6f obal spurious do
d810: 6e 65 20 6c 65 6e 0a 09 73 65 74 20 6c 20 5b 72 ne len..set l [r
d820: 65 61 64 20 24 73 20 31 5d 0a 09 69 66 20 7b 5b ead $s 1]..if {[
d830: 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 20 24 6c string length $l
d840: 5d 20 3d 3d 20 30 7d 20 7b 0a 09 20 20 20 20 69 ] == 0} {.. i
d850: 66 20 7b 21 5b 65 6f 66 20 24 73 5d 7d 20 7b 0a f {![eof $s]} {.
d860: 09 09 69 6e 63 72 20 73 70 75 72 69 6f 75 73 0a ..incr spurious.
d870: 09 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 09 . } else {...
d880: 63 6c 6f 73 65 20 24 73 0a 09 09 73 65 74 20 64 close $s...set d
d890: 6f 6e 65 20 31 0a 09 20 20 20 20 7d 0a 09 7d 20 one 1.. }..}
d8a0: 65 6c 73 65 20 7b 0a 09 20 20 20 20 69 6e 63 72 else {.. incr
d8b0: 20 6c 65 6e 20 5b 73 74 72 69 6e 67 20 6c 65 6e len [string len
d8c0: 67 74 68 20 24 6c 5d 0a 09 7d 0a 20 20 20 20 7d gth $l]..}. }
d8d0: 0a 20 20 20 20 70 72 6f 63 20 61 63 63 65 70 74 . proc accept
d8e0: 20 7b 73 20 61 20 70 7d 20 7b 0a 09 66 63 6f 6e {s a p} {..fcon
d8f0: 66 69 67 75 72 65 20 24 73 20 2d 62 6c 6f 63 6b figure $s -block
d900: 69 6e 67 20 30 0a 09 66 69 6c 65 65 76 65 6e 74 ing 0..fileevent
d910: 20 24 73 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 $s readable [li
d920: 73 74 20 64 6f 5f 68 61 6e 64 73 68 61 6b 65 20 st do_handshake
d930: 24 73 20 72 65 61 64 61 62 6c 65 20 72 65 61 64 $s readable read
d940: 6c 69 74 74 6c 65 20 5c 0a 09 09 2d 62 75 66 66 little \...-buff
d950: 65 72 69 6e 67 20 6e 6f 6e 65 5d 0a 20 20 20 20 ering none].
d960: 7d 0a 20 20 20 20 73 65 74 20 73 20 5b 74 6c 73 }. set s [tls
d970: 3a 3a 73 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 ::socket -certfi
d980: 6c 65 20 24 73 65 72 76 65 72 43 65 72 74 20 2d le $serverCert -
d990: 63 61 66 69 6c 65 20 24 63 61 43 65 72 74 20 2d cafile $caCert -
d9a0: 6b 65 79 66 69 6c 65 20 24 73 65 72 76 65 72 4b keyfile $serverK
d9b0: 65 79 20 5c 0a 09 20 20 20 20 2d 73 65 72 76 65 ey \.. -serve
d9c0: 72 20 61 63 63 65 70 74 20 38 38 33 31 5d 0a 20 r accept 8831].
d9d0: 20 20 20 73 65 74 20 63 20 5b 74 6c 73 3a 3a 73 set c [tls::s
d9e0: 6f 63 6b 65 74 20 2d 63 65 72 74 66 69 6c 65 20 ocket -certfile
d9f0: 24 63 6c 69 65 6e 74 43 65 72 74 20 2d 63 61 66 $clientCert -caf
da00: 69 6c 65 20 24 63 61 43 65 72 74 20 2d 6b 65 79 ile $caCert -key
da10: 66 69 6c 65 20 24 63 6c 69 65 6e 74 4b 65 79 20 file $clientKey
da20: 5c 0a 09 20 20 20 20 6c 6f 63 61 6c 68 6f 73 74 \.. localhost
da30: 20 38 38 33 31 5d 0a 20 20 20 20 23 20 6f 6e 6c 8831]. # onl
da40: 79 20 74 68 65 20 63 6c 69 65 6e 74 20 67 65 74 y the client get
da50: 73 20 74 6c 73 3a 3a 69 6d 70 6f 72 74 0a 20 20 s tls::import.
da60: 20 20 73 65 74 20 72 65 73 20 5b 74 6c 73 3a 3a set res [tls::
da70: 75 6e 69 6d 70 6f 72 74 20 24 63 5d 0a 20 20 20 unimport $c].
da80: 20 6c 69 73 74 20 24 72 65 73 20 5b 63 61 74 63 list $res [catc
da90: 68 20 7b 63 6c 6f 73 65 20 24 63 7d 20 65 72 72 h {close $c} err
daa0: 5d 20 24 65 72 72 20 5c 0a 09 5b 63 61 74 63 68 ] $err \..[catch
dab0: 20 7b 63 6c 6f 73 65 20 24 73 7d 20 65 72 72 5d {close $s} err]
dac0: 20 24 65 72 72 0a 7d 20 7b 7b 7d 20 30 20 7b 7d $err.} {{} 0 {}
dad0: 20 30 20 7b 7d 7d 0a 0a 74 65 73 74 20 74 6c 73 0 {}}..test tls
dae0: 2d 62 75 67 35 38 2d 31 2e 30 20 7b 74 65 73 74 -bug58-1.0 {test
daf0: 20 70 72 6f 74 6f 63 6f 6c 20 6e 65 67 6f 74 69 protocol negoti
db00: 61 74 69 6f 6e 20 66 61 69 6c 75 72 65 7d 20 7b ation failure} {
db10: 73 6f 63 6b 65 74 7d 20 7b 0a 20 20 20 20 23 20 socket} {. #
db20: 46 6f 6c 6c 6f 77 69 6e 67 20 63 6f 64 65 20 69 Following code i
db30: 73 20 62 61 73 65 64 20 6f 6e 20 77 68 61 74 20 s based on what
db40: 77 61 73 20 72 65 70 6f 72 74 65 64 20 69 6e 20 was reported in
db50: 62 75 67 20 23 35 38 2e 20 50 72 69 6f 72 0a 20 bug #58. Prior.
db60: 20 20 20 23 20 74 6f 20 66 69 78 20 74 68 65 20 # to fix the
db70: 70 72 6f 67 72 61 6d 20 77 6f 75 6c 64 20 63 72 program would cr
db80: 61 73 68 20 77 69 74 68 20 61 20 73 65 67 66 61 ash with a segfa
db90: 75 6c 74 2e 0a 20 20 20 20 70 72 6f 63 20 41 63 ult.. proc Ac
dba0: 63 65 70 74 20 7b 73 6f 63 6b 20 61 72 67 73 7d cept {sock args}
dbb0: 20 7b 0a 20 20 20 20 20 20 20 20 66 63 6f 6e 66 {. fconf
dbc0: 69 67 75 72 65 20 24 73 6f 63 6b 20 2d 62 6c 6f igure $sock -blo
dbd0: 63 6b 69 6e 67 20 30 3b 0a 20 20 20 20 20 20 20 cking 0;.
dbe0: 20 66 69 6c 65 65 76 65 6e 74 20 24 73 6f 63 6b fileevent $sock
dbf0: 20 72 65 61 64 61 62 6c 65 20 5b 6c 69 73 74 20 readable [list
dc00: 48 61 6e 64 73 68 61 6b 65 20 24 73 6f 63 6b 5d Handshake $sock]
dc10: 0a 20 20 20 20 7d 0a 20 20 20 20 70 72 6f 63 20 . }. proc
dc20: 48 61 6e 64 73 68 61 6b 65 20 7b 73 6f 63 6b 7d Handshake {sock}
dc30: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 3a {. set :
dc40: 3a 64 6f 6e 65 20 48 41 4e 44 0a 20 20 20 20 20 :done HAND.
dc50: 20 20 20 63 61 74 63 68 20 7b 74 6c 73 3a 3a 68 catch {tls::h
dc60: 61 6e 64 73 68 61 6b 65 20 24 73 6f 63 6b 7d 20 andshake $sock}
dc70: 6d 73 67 0a 20 20 20 20 20 20 20 20 73 65 74 20 msg. set
dc80: 3a 3a 64 6f 6e 65 20 24 6d 73 67 0a 20 20 20 20 ::done $msg.
dc90: 7d 0a 20 20 20 20 23 20 4e 4f 54 45 3a 20 77 68 }. # NOTE: wh
dca0: 65 6e 20 64 6f 69 6e 67 20 61 6e 20 69 6e 2d 70 en doing an in-p
dcb0: 72 6f 63 65 73 73 20 63 6c 69 65 6e 74 2f 73 65 rocess client/se
dcc0: 72 76 65 72 20 74 65 73 74 2c 20 62 6f 74 68 20 rver test, both
dcd0: 73 69 64 65 73 20 6e 65 65 64 0a 20 20 20 20 23 sides need. #
dce0: 20 74 6f 20 62 65 20 6e 6f 6e 2d 62 6c 6f 63 6b to be non-block
dcf0: 69 6e 67 20 66 6f 72 20 74 68 65 20 54 4c 53 20 ing for the TLS
dd00: 68 61 6e 64 73 68 61 6b 65 0a 0a 20 20 20 20 23 handshake.. #
dd10: 20 53 65 72 76 65 72 20 2d 20 4f 6e 6c 79 20 61 Server - Only a
dd20: 63 63 65 70 74 20 54 4c 53 20 31 2e 32 0a 20 20 ccept TLS 1.2.
dd30: 20 20 73 65 74 20 73 20 5b 74 6c 73 3a 3a 73 6f set s [tls::so
dd40: 63 6b 65 74 20 5c 0a 20 20 20 20 20 20 20 20 2d cket \. -
dd50: 63 65 72 74 66 69 6c 65 20 24 73 65 72 76 65 72 certfile $server
dd60: 43 65 72 74 20 2d 63 61 66 69 6c 65 20 24 63 61 Cert -cafile $ca
dd70: 43 65 72 74 20 2d 6b 65 79 66 69 6c 65 20 24 73 Cert -keyfile $s
dd80: 65 72 76 65 72 4b 65 79 20 2d 72 65 71 75 65 73 erverKey -reques
dd90: 74 20 30 20 5c 0a 09 2d 72 65 71 75 69 72 65 20 t 0 \..-require
dda0: 30 20 2d 73 73 6c 32 20 30 20 2d 73 73 6c 33 20 0 -ssl2 0 -ssl3
ddb0: 30 20 2d 74 6c 73 31 20 30 20 2d 74 6c 73 31 2e 0 -tls1 0 -tls1.
ddc0: 31 20 30 20 2d 74 6c 73 31 2e 32 20 31 20 2d 74 1 0 -tls1.2 1 -t
ddd0: 6c 73 31 2e 33 20 30 20 5c 0a 20 20 20 20 20 20 ls1.3 0 \.
dde0: 20 20 2d 73 65 72 76 65 72 20 41 63 63 65 70 74 -server Accept
ddf0: 20 38 38 33 31 5d 0a 20 20 20 20 23 20 43 6c 69 8831]. # Cli
de00: 65 6e 74 20 2d 20 4f 6e 6c 79 20 70 72 6f 70 6f ent - Only propo
de10: 73 65 20 54 4c 53 31 2e 30 0a 20 20 20 20 73 65 se TLS1.0. se
de20: 74 20 63 20 5b 74 6c 73 3a 3a 73 6f 63 6b 65 74 t c [tls::socket
de30: 20 2d 61 73 79 6e 63 20 2d 63 61 66 69 6c 65 20 -async -cafile
de40: 24 63 61 43 65 72 74 20 2d 72 65 71 75 65 73 74 $caCert -request
de50: 20 30 20 2d 72 65 71 75 69 72 65 20 30 20 5c 0a 0 -require 0 \.
de60: 09 2d 73 73 6c 32 20 30 20 2d 73 73 6c 33 20 30 .-ssl2 0 -ssl3 0
de70: 20 2d 74 6c 73 31 20 31 20 2d 74 6c 73 31 2e 31 -tls1 1 -tls1.1
de80: 20 30 20 2d 74 6c 73 31 2e 32 20 30 20 2d 74 6c 0 -tls1.2 0 -tl
de90: 73 31 2e 33 20 30 20 6c 6f 63 61 6c 68 6f 73 74 s1.3 0 localhost
dea0: 20 38 38 33 31 5d 0a 20 20 20 20 66 63 6f 6e 66 8831]. fconf
deb0: 69 67 75 72 65 20 24 63 20 2d 62 6c 6f 63 6b 69 igure $c -blocki
dec0: 6e 67 20 30 0a 20 20 20 20 70 75 74 73 20 24 63 ng 0. puts $c
ded0: 20 61 20 3b 20 66 6c 75 73 68 20 24 63 0a 20 20 a ; flush $c.
dee0: 20 20 61 66 74 65 72 20 35 30 30 30 20 5b 6c 69 after 5000 [li
def0: 73 74 20 73 65 74 20 3a 3a 64 6f 6e 65 20 74 69 st set ::done ti
df00: 6d 65 6f 75 74 5d 0a 20 20 20 20 76 77 61 69 74 meout]. vwait
df10: 20 3a 3a 64 6f 6e 65 0a 20 20 20 20 73 77 69 74 ::done. swit
df20: 63 68 20 2d 65 78 61 63 74 20 2d 2d 20 24 3a 3a ch -exact -- $::
df30: 64 6f 6e 65 20 7b 0a 20 20 20 20 20 20 20 20 22 done {. "
df40: 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c 65 64 handshake failed
df50: 3a 20 77 72 6f 6e 67 20 73 73 6c 20 76 65 72 73 : wrong ssl vers
df60: 69 6f 6e 22 20 2d 0a 20 20 20 20 20 20 20 20 22 ion" -. "
df70: 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c 65 64 handshake failed
df80: 3a 20 75 6e 73 75 70 70 6f 72 74 65 64 20 70 72 : unsupported pr
df90: 6f 74 6f 63 6f 6c 22 20 7b 0a 20 20 20 20 20 20 otocol" {.
dfa0: 20 20 20 20 20 20 73 65 74 20 3a 3a 64 6f 6e 65 set ::done
dfb0: 20 22 68 61 6e 64 73 68 61 6b 65 20 66 61 69 6c "handshake fail
dfc0: 65 64 3a 20 77 72 6f 6e 67 20 76 65 72 73 69 6f ed: wrong versio
dfd0: 6e 20 6e 75 6d 62 65 72 22 0a 20 20 20 20 20 20 n number".
dfe0: 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 }. }. se
dff0: 74 20 3a 3a 64 6f 6e 65 0a 7d 20 7b 68 61 6e 64 t ::done.} {hand
e000: 73 68 61 6b 65 20 66 61 69 6c 65 64 3a 20 77 72 shake failed: wr
e010: 6f 6e 67 20 76 65 72 73 69 6f 6e 20 6e 75 6d 62 ong version numb
e020: 65 72 7d 0a 0a 23 20 63 6c 65 61 6e 75 70 0a 69 er}..# cleanup.i
e030: 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63 68 f {[string match
e040: 20 73 6f 63 6b 2a 20 24 63 6f 6d 6d 61 6e 64 53 sock* $commandS
e050: 6f 63 6b 65 74 5d 20 3d 3d 20 31 7d 20 7b 0a 20 ocket] == 1} {.
e060: 20 20 70 75 74 73 20 24 63 6f 6d 6d 61 6e 64 53 puts $commandS
e070: 6f 63 6b 65 74 20 65 78 69 74 0a 20 20 20 66 6c ocket exit. fl
e080: 75 73 68 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b ush $commandSock
e090: 65 74 0a 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 et.}.catch {clos
e0a0: 65 20 24 63 6f 6d 6d 61 6e 64 53 6f 63 6b 65 74 e $commandSocket
e0b0: 7d 0a 63 61 74 63 68 20 7b 63 6c 6f 73 65 20 24 }.catch {close $
e0c0: 72 65 6d 6f 74 65 50 72 6f 63 43 68 61 6e 7d 0a remoteProcChan}.
e0d0: 3a 3a 74 63 6c 74 65 73 74 3a 3a 63 6c 65 61 6e ::tcltest::clean
e0e0: 75 70 54 65 73 74 73 0a 66 6c 75 73 68 20 73 74 upTests.flush st
e0f0: 64 6f 75 74 0a 72 65 74 75 72 6e 0a dout.return.